home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / c / rmxker.p86 < prev    next >
Encoding:
Text File  |  1988-08-16  |  66.7 KB  |  2,949 lines
  1. /*
  2.  Note, the following source files are concatenated together in this file:
  3.    CMDS.P86
  4.    CONN.P86
  5.    GET.P86
  6.    KERMIT.P86
  7.    RECV.P86
  8.    SEND.P86
  9.    TRANS.P86
  10.  Each one begins with a comment containing its name, like the one below:
  11. */
  12. /*---CMDS.P86---*/
  13. $compact
  14. $optimize(3)
  15.  
  16. cmds:
  17. do;
  18.  
  19. declare true literally '0FFH';
  20. declare false literally '00H';
  21. $INCLUDE(:INC:LTKSEL.LIT)
  22. $INCLUDE(:INC:NEXCEP.LIT)
  23. $INCLUDE(:INC:IEXCEP.LIT)
  24.  
  25. declare null literally '000H';
  26. declare lf literally '0AH';
  27. declare cr literally '0DH';
  28. declare crlf literally 'cr,lf,null';
  29. declare space literally '20H';
  30. declare dollar literally '24H';
  31. declare soh literally '1';
  32.  
  33. declare num_cmds literally '19';
  34. declare num_para literally '17';
  35. declare num_opt  literally '8';
  36. declare num_remote literally '10';
  37. declare num_dup  literally '2';
  38. declare num_baud literally '7';
  39. declare num_log  literally '2';
  40. declare cmd_list (num_cmds) structure
  41.     (symbol(12) byte) data
  42.     ('BYE         ',
  43.      'CONNECT     ',
  44.      'DEFINE      ',
  45.      'EXIT        ',
  46.      'FINISH      ',
  47.      'GET         ',
  48.      'HELP        ',
  49.      'LOCAL       ',
  50.      'LOG         ',
  51.      'QUIT        ',
  52.      'RECIEVE     ',
  53.      'REMOTE      ',
  54.      'SEND        ',
  55.      'SERVER      ',
  56.      'SET         ',
  57.      'SHOW        ',
  58.      'STATISTICS  ',
  59.      'TAKE        ',
  60.      'TRANSMIT    ');
  61. declare para_list (num_para) structure
  62.     (symbol(12) byte) data
  63.     ('BAUD_RATE   ',
  64.      'BLOCK_CHECK ',
  65.      'DEBUGGING   ',
  66.      'DELAY       ',
  67.      'DUPLEX      ',
  68.      'ESCAPE      ',
  69.      'FILE        ',
  70.      'FLOW_CONTROL',
  71.      'HANDSHAKE   ',
  72.      'IBM         ',
  73.      'INCOMPLETE  ',
  74.      'LINE        ',
  75.      'PARITY      ',
  76.      'PORT        ',
  77.      'RECIEVE     ',
  78.      'RETRY       ',
  79.      'SEND        ');
  80. declare opt_list (num_opt) structure
  81.     (symbol(12) byte) DATA
  82.     ('END_OF_LINE ',
  83.      'PACKET_LENGT',
  84.      'PADCHAR     ',
  85.      'PADDING     ',
  86.      'PAUSE       ',
  87.      'QUOTE       ',
  88.      'START_OF_PAC',
  89.      'TIMEOUT     ');
  90. declare remote_list (num_remote) structure
  91.     (symbol(12) byte) DATA
  92.     ('CWD         ',
  93.      'DELETE      ',
  94.      'DIRECTORY   ',
  95.      'DISK        ',
  96.      'HELP        ',
  97.      'HOST        ',
  98.      'KERMIT      ',
  99.      'RUN         ',
  100.      'PROGRAM     ',
  101.      'TYPE        ');
  102. declare dup_list(num_dup) structure
  103.     (symbol(12) byte) DATA
  104.     ('FULL        ',
  105.      'HALF        ');
  106. declare baud_list(num_baud) structure
  107.     (symbol(12) byte) DATA
  108.     ('0           ',
  109.      '300         ',
  110.      '1200        ',
  111.      '2400        ',
  112.      '4800        ',
  113.      '9600        ',
  114.      '19200       ');
  115. declare log_list (num_log) structure
  116.     (symbol(12) byte) data
  117.     ('TRANSACTIONS',
  118.      'SESSION     ');
  119.  
  120. declare buflen literally '122';
  121. declare buffer(buflen) byte EXTERNAL;
  122. declare cmdstr(buflen) byte EXTERNAL;
  123. declare status word EXTERNAL;
  124. declare baud_rate word EXTERNAL;
  125. declare duplex byte external;
  126. declare parity byte EXTERNAL;
  127. declare delim byte external;
  128.  
  129.  
  130. declare cmd byte external;
  131. declare in$conn token EXTERNAL;
  132. declare out$conn token EXTERNAL;
  133. declare ci$conn token EXTERNAL;
  134. declare co$conn token EXTERNAL;
  135.  
  136. declare filename structure
  137.     (len byte,
  138.      name(80) byte) EXTERNAL;
  139. declare file$conn token EXTERNAL;
  140.  
  141. declare debug byte EXTERNAL;
  142. declare qopen byte EXTERNAL;
  143.  
  144. /* here are the subroutines */
  145.  
  146. $INCLUDE(:INC:UFLINF.EXT)
  147. $INCLUDE(:INC:UATACH.EXT)
  148. $INCLUDE(:INC:UOPEN.EXT)
  149. $INCLUDE(:INC:UCLOSE.EXT)
  150. $INCLUDE(:INC:UWRITE.EXT)
  151. $INCLUDE(:INC:UDCEX.EXT)
  152. $INCLUDE(:INC:UCREAT.EXT)
  153. $INCLUDE(:INC:UDCTIM.EXT)
  154. $INCLUDE(:INC:UDETAC.EXT)
  155. $INCLUDE(:INC:ISSPEC.EXT)
  156. $INCLUDE(:INC:USPECL.EXT)
  157. $INCLUDE(:INC:USWBF.EXT)
  158. $INCLUDE(:INC:UREAD.EXT)
  159. $INCLUDE(:INC:UEXIT.EXT)
  160. $INCLUDE(:INC:UGTARG.EXT)
  161.  
  162.  
  163. check$error: PROCEDURE (fatal) byte EXTERNAL;
  164.     declare fatal byte;
  165. end check$error;
  166.  
  167. nout:    procedure(n) EXTERNAL;
  168.     declare n word;
  169. end nout;
  170.  
  171. nin:    procedure(string) address EXTERNAL;
  172.     declare string address;
  173. end nin;
  174.  
  175. co: procedure(c) EXTERNAL;
  176.     declare c byte;
  177. end co;
  178.  
  179. do$co: procedure EXTERNAL;
  180. end do$co;
  181.  
  182. newline: procedure EXTERNAL;
  183. end newline;
  184.  
  185. prints:    procedure(msg) EXTERNAL;
  186.     declare msg pointer;
  187. end prints;
  188.  
  189. print:    procedure(msg) EXTERNAL;
  190.     declare msg pointer;
  191. end print;
  192.  
  193. file$close: procedure EXTERNAL;
  194. end file$close;
  195.  
  196. query: procedure byte EXTERNAL;
  197. end query;
  198.  
  199. print$char: procedure (char);
  200.     declare char byte;
  201.     filename.name(filename.len)=char;
  202.     filename.len=filename.len+1;
  203. end print$char;
  204.  
  205. print$str: procedure (ptr);
  206.     declare ptr pointer;
  207.     call movb(ptr,@filename.name(filename.len),12);
  208.     filename.len=filename.len+12;
  209. end print$str;
  210.  
  211. do$print$str: procedure;
  212.     filename.name(filename.len)=cr;
  213.     filename.name(filename.len+1)=lf;
  214.     filename.len=filename.len+2;
  215.     call prints(@filename);
  216.     filename.len=0;
  217. end do$print$str;
  218.  
  219. bye$cmd: procedure EXTERNAL;
  220. end bye$cmd;
  221.  
  222. conn$cmd: procedure EXTERNAL;
  223. end conn$cmd;
  224.  
  225. def$cmd: procedure EXTERNAL;
  226. end def$cmd;
  227.  
  228. exit$cmd: procedure (code) EXTERNAL;
  229.     declare code byte;
  230. end exit$cmd;
  231.  
  232. fin$cmd: procedure EXTERNAL;
  233. end fin$cmd;
  234.  
  235. get$cmd: procedure EXTERNAL;
  236. end get$cmd;
  237.  
  238. help$cmd: procedure;
  239.     if delim<>cr then do;
  240.         delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  241.         if check$error(0) then return;
  242.         cmd=decode$cmd(@cmdstr,@cmd_list,num_cmds);
  243.         if cmd=true then call ambiguous;
  244.         else do;
  245.           do case cmd;
  246.             call unknown(@(5,'Help '));
  247.             call bye$help;
  248.             call conn$help;
  249.             call def$help;
  250.             call exit$help;
  251.             call fin$help;
  252.             call get$help;
  253.             call help$help;
  254.             call loc$help;
  255.             call log$help;
  256.             call quit$help;
  257.             call recv$help;
  258.             call rem$help;
  259.             call send$help;
  260.             call serv$help;
  261.             call set$help;
  262.             call show$help;
  263.             call stat$help;
  264.             call take$help;
  265.             call tran$help;
  266.           end;
  267.           if cmd <> 0 then return;
  268.         end;
  269.     end;
  270.     call help$help;
  271. end help$cmd;
  272.  
  273. loc$cmd: procedure EXTERNAL;
  274. end loc$cmd;
  275.  
  276. log$cmd: procedure EXTERNAL;
  277. end log$cmd;
  278.  
  279. recv$cmd: procedure EXTERNAL;
  280. end recv$cmd;
  281.  
  282. rem$cmd: procedure EXTERNAL;
  283. end rem$cmd;
  284.  
  285. send$cmd: procedure EXTERNAL;
  286. end send$cmd;
  287.  
  288. serv$cmd: procedure EXTERNAL;
  289. end serv$cmd;
  290.  
  291. set$cmd: procedure EXTERNAL;
  292. end set$cmd;
  293.  
  294. show$cmd: procedure EXTERNAL;
  295. end show$cmd;
  296.  
  297. stat$cmd: procedure EXTERNAL;
  298. end stat$cmd;
  299.  
  300. take$cmd: procedure EXTERNAL;
  301. end take$cmd;
  302.  
  303. tran$cmd: procedure EXTERNAL;
  304. end tran$cmd;
  305.  
  306. help$log$trans: procedure;
  307.     call undocumented;
  308. end help$log$trans;
  309.  
  310. help$log$session: procedure;
  311.     call undocumented;
  312. end help$log$session;
  313.  
  314. undocumented: procedure;
  315.     call print(@('Help documentation not yet available',crlf));
  316. end undocumented;
  317.  
  318. ambiguous: procedure PUBLIC;
  319.     call print(@('ambiguous command',crlf));
  320. end ambiguous;
  321.  
  322. unsupported: procedure PUBLIC;
  323.     call print(@('not presently supported',crlf));
  324. end unsupported;
  325.  
  326. unknown: procedure(cmd$ptr) PUBLIC;
  327.     declare cmd$ptr pointer;
  328.     declare cmd based cmd$ptr structure
  329.         (len byte,
  330.          symbol(12) byte);
  331.     call print(@('unknown ',null));
  332.     if cmd.len>0 then call prints(cmd$ptr);
  333.     call print(@('command, check spelling',crlf));
  334. end unknown;
  335.  
  336. decode$cmd: procedure (cmd$ptr,list$ptr,num) byte PUBLIC;
  337.     declare cmd$ptr pointer;
  338.     declare list$ptr pointer;
  339.     declare num byte;
  340.     declare list based list$ptr (1) structure
  341.         (symbol(12) byte);
  342.     declare cmd based cmd$ptr structure
  343.         (len byte,
  344.          symbol(12) byte);
  345.     declare (i,j,ix) byte;
  346.     if debug then call prints(cmd$ptr);
  347.     ix=0;
  348.     if cmd.len>12 then cmd.len=12;
  349.     else if cmd.len=0 then return ix;
  350.     do i=1 to num;
  351.       do j=1 to cmd.len;    
  352.         if cmd.symbol(j-1) <> list(i-1).symbol(j-1) then goto nexti;
  353.       end;
  354.       if ix<>0 then ix=true;
  355.       else ix=i;
  356. nexti: end;
  357.     if debug then call nout(ix);
  358.     return ix;
  359. end decodecmd;
  360.  
  361. do$cmd: procedure PUBLIC;
  362.     do case cmd;
  363.         call unknown(@(0));
  364.         call bye$cmd;
  365.         call conn$cmd;
  366.         call def$cmd;
  367.         call exit$cmd(0);
  368.         call fin$cmd;
  369.         call get$cmd;
  370.         call help$cmd;
  371.         call loc$cmd;
  372.         call log$cmd;
  373.         call exit$cmd(0);
  374.         call recv$cmd;
  375.         call rem$cmd;
  376.         call send$cmd;
  377.         call serv$cmd;
  378.         call set$cmd;
  379.         call show$cmd;
  380.         call stat$cmd;
  381.         call take$cmd;
  382.         call tran$cmd;
  383.     end;
  384. end do$cmd;
  385.  
  386. do$para: procedure PUBLIC;
  387.     do case cmd;
  388.         call unknown(@(10,'parameter '));
  389.         call baud$para;
  390.         call block$para;
  391.         call debug$para;
  392.         call delay$para;
  393.         call dup$para;
  394.         call esc$para;
  395.         call file$para;
  396.         call flow$para;
  397.         call hand$para;
  398.         call ibm$para;
  399.         call inco$para;
  400.         call port$para;
  401.         call par$para;
  402.         call port$para;
  403.         call recv$para;
  404.         call retry$para;
  405.         call send$para;
  406.     end;
  407. end do$para;
  408.  
  409. get$in$cmd: procedure PUBLIC;
  410.     cmd=decode$cmd(@cmdstr,@cmd_list,num_cmds);
  411.     if cmd=true then call ambiguous;
  412.     else call do$cmd;
  413. end get$in$cmd;
  414.  
  415. get$baud: procedure PUBLIC;
  416.       cmd=decode$cmd(@cmdstr,@baud_list,num_baud);
  417.       if cmd=true then call ambiguous;
  418.       else do case cmd;
  419.         call unknown(@(10,'baud rate '));
  420.         baud_rate=0;
  421.         baud_rate=300;
  422.         baud_rate=1200;
  423.         baud_rate=2400;
  424.         baud_rate=4800;
  425.         baud_rate=9600;
  426.         baud_rate=19200;
  427.       end;
  428. end get$baud;
  429.  
  430. get$para: procedure PUBLIC;
  431.     cmd=decode$cmd(@cmdstr,@para_list,num_para);
  432.     if cmd=true then call ambiguous;
  433.     else call do$para;
  434. end get$para;
  435.  
  436. output$baud: procedure PUBLIC;
  437.         if cmd=1 then call print(@('system default',null));
  438.         else do;
  439.           call co(baud_list(cmd-1).symbol(0));
  440.           call co(baud_list(cmd-1).symbol(1));
  441.           call co(baud_list(cmd-1).symbol(2));
  442.           call co(baud_list(cmd-1).symbol(3));
  443.           if cmd=7 then call co(baud_list(cmd-1).symbol(4));
  444.         end;
  445. end output$baud;
  446.  
  447. get$duplex: procedure PUBLIC;
  448.       cmd=decode$cmd(@cmdstr,@dup_list,num_dup);
  449.       if cmd=true then call ambiguous;
  450.       else do case cmd;
  451.         call unknown(@(7,'duplex '));
  452.         duplex=0;
  453.         duplex=1;
  454.       end;
  455. end get$duplex;
  456.  
  457. baud$para: procedure EXTERNAL;
  458. end baud$para;
  459.  
  460. block$para: procedure EXTERNAL;
  461. end block$para;
  462.  
  463. debug$para: procedure EXTERNAL;
  464. end debug$para;
  465.  
  466. delay$para: procedure EXTERNAL;
  467. end delay$para;
  468.  
  469. dup$para: procedure EXTERNAL;
  470. end dup$para;
  471.  
  472. esc$para: procedure EXTERNAL;
  473. end esc$para;
  474.  
  475. file$para: procedure EXTERNAL;
  476. end file$para;
  477.  
  478. flow$para: procedure EXTERNAL;
  479. end flow$para;
  480.  
  481. hand$para: procedure EXTERNAL;
  482. end hand$para;
  483.  
  484. ibm$para: procedure EXTERNAL;
  485. end ibm$para;
  486.  
  487. inco$para: procedure EXTERNAL;
  488. end inco$para;
  489.  
  490. par$para: procedure EXTERNAL;
  491. end par$para;
  492.  
  493. port$para: procedure EXTERNAL;
  494. end port$para;
  495.  
  496. recv$para: procedure EXTERNAL;
  497. end recv$para;
  498.  
  499. retry$para: procedure EXTERNAL;
  500. end retry$para;
  501.  
  502. send$para: procedure EXTERNAL;
  503. end send$para;
  504.  
  505. bye$help: procedure;
  506.     call print(@('SYNTAX: Bye',crlf));
  507.     call print(@(lf,'Sends a message to remote kermit to exit from',
  508.             ' server mode,',crlf));
  509.     call print(@('  and logout of remote system',crlf));
  510.     call print(@('  also exits from local program',crlf));
  511. end bye$help;
  512.  
  513. conn$help: procedure;
  514.     call print(@('SYNTAX: Connect [device]',crlf));
  515.     call print(@(lf,'Makes a virtual terminal connection',
  516.             ' via specified device',crlf));
  517.     call print(@('  if device not specified uses the one set up',
  518.             ' by SET LINE command',crlf));
  519.     call print(@(' to break the connection type ^] C',crlf));
  520.     call print(@(lf,'SPECIAL NOTE: Because ^C is special for RMX,',crlf));
  521.     call print(@(' to send a control-C via the connection type ^] ^Y',crlf));
  522. end conn$help;
  523.  
  524. def$help: procedure;
  525.     call print(@('SYNTAX: Define macroname [set-parameters]',crlf));
  526.     call undocumented;
  527. end def$help;
  528.  
  529. exit$help: procedure;
  530.     call print(@('SYNTAX: Exit',crlf));
  531.     call print(@(lf,'exits from program',crlf));
  532. end exit$help;
  533.  
  534. fin$help: procedure;
  535.     call print(@('SYNTAX: Finish',crlf));
  536.     call print(@(lf,'Sends a message to remote kermit to exit from',
  537.             ' server mode,',crlf));
  538.     call print(@('  and remote KERMIT but not logout of system',crlf));
  539. end fin$help;
  540.  
  541. get$help: procedure;
  542.     call print(@('SYNTAX: Get filespec1 [filespec2]',crlf));
  543.     call print(@(lf,'filespec1 is remote filespec and may',
  544.             ' have wildcards',crlf));
  545.     call print(@('filespec2 is local name to store file in,',
  546.             ' no wildcard support',crlf));
  547. end get$help;
  548.  
  549. help$help: procedure;
  550.     declare i byte;
  551.     call print(@('Help is available on the following commands:',crlf));
  552.     call newline;
  553.     filename.len=0;
  554.     do i=0 to num_cmds-1;
  555.         call print$str(@cmd_list(i));
  556.         if (i mod 5)=4 then call do$print$str;
  557.     end;
  558.     if (num_cmds mod 5)<>0 then call do$print$str;
  559.     call newline;
  560.     call print(@('Abreviations are allowed as long as',
  561.                 ' they are unique',crlf));
  562. end help$help;
  563.  
  564. loc$help: procedure;
  565.     if delim<>cr then do;
  566.         call undocumented;
  567.     end;
  568.     call print(@('SYNTAX: LOCal command',crlf));
  569. end loc$help;
  570.  
  571. log$help: procedure;
  572.     if delim<>cr then do;
  573.         delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  574.         if check$error(0) then return;
  575.         cmd=decode$cmd(@cmdstr,@cmd_list,num_cmds);
  576.         if cmd=true then call ambiguous;
  577.         else do;
  578.           do case cmd;
  579.             call unknown(@(4,'Log '));
  580.             call help$log$trans;
  581.             call help$log$session;
  582.           end;
  583.           if cmd <> 0 then return;
  584.         end;
  585.     end;
  586.     call print(@('SYNTAX: LOG [option] [filespec]',crlf));
  587.     call print(@('  legal options are:',null));
  588.     filename.len=0;
  589.     call print$str(@log_list(0));
  590.     call print$char(' ');
  591.     call print$str(@log_list(1));
  592.     call do$print$str;
  593.     call print(@(lf,'logs the specified option to the specified',
  594.             ' log file',crlf));
  595.     call print(@('  if filespec is omitted, defaults to KERMIT.LOG',
  596.             ' in the default directory',crlf));
  597. end log$help;
  598.  
  599. quit$help: procedure;
  600.     call print(@('SYNTAX: Quit',crlf));
  601.     call print(@(lf,'exits from program',crlf));
  602. end quit$help;
  603.  
  604. recv$help: procedure;
  605.     call print(@('SYNTAX: RECieve [filespec]',crlf));
  606.     call print(@(lf,'if filespec is missing or more than one',
  607.             ' file is recieved,',crlf));
  608.     call print(@(' will use filespec from other computer.',crlf));
  609.     call print(@('No filename tranformation is available yet',crlf));
  610. end recv$help;
  611.  
  612. rem$help: procedure;
  613.     if delim<>cr then do;
  614.         call undocumented;
  615.     end;
  616.     call print(@('SYNTAX: REMote command',crlf));
  617. end rem$help;
  618.  
  619. send$help: procedure;
  620.     call print(@('SYNTAX: SENd filespec1 [filespec2]',crlf));
  621.     call print(@(lf,'filespec1 may have wildcard parameters',crlf));
  622.     call print(@('filespec2 is not preently used.',crlf));
  623. end send$help;
  624.  
  625. serv$help: procedure;
  626.     call print(@('SYNTAX: SERver',crlf));
  627.     call undocumented;
  628. end serv$help;
  629.  
  630. set$help: procedure;
  631.     declare i byte;
  632.     if delim<>cr then do;
  633.         call undocumented;
  634.     end;
  635.     call print(@('SYNTAX: SET parameter [option] [value]',crlf));
  636.     call print(@(lf,'Help is available on the following parameters:',crlf));
  637.     call newline;
  638.     filename.len=0;
  639.     do i=0 to num_para-1;
  640.         call print$str(@para_list(i));
  641.         call print$char(' ');
  642.         if (i mod 5)=4 then call do$print$str;
  643.     end;
  644.     if (num_para mod 5)<>0 then call do$print$str;
  645.     call newline;
  646. end set$help;
  647.  
  648. show$help: procedure;
  649.     declare i byte;
  650.     call print(@('SYNTAX: SHow [parameter]',crlf));
  651.     call print(@(lf,'If parameter is omitted,',
  652.             ' all parameters are shown',crlf));
  653.     call print(@('The following are legal parameters:',crlf));
  654.     call newline;
  655.     filename.len=0;
  656.     do i=0 to num_para-1;
  657.         call print$str(@para_list(i));
  658.         call print$char(' ');
  659.         if (i mod 5)=4 then call do$print$str;
  660.     end;
  661.     if (num_para mod 5)<>0 then call do$print$str;
  662.     call newline;
  663. end show$help;
  664.  
  665. stat$help: procedure;
  666.     call print(@('SYNTAX: STatistics',crlf));
  667.     call print(@(lf,'Gives statistics on the most recent transfer',crlf));
  668. end stat$help;
  669.  
  670. take$help: procedure;
  671.     call print(@('SYNTAX: TAke filespec',crlf));
  672.     call print(@(lf,'Reads KERMIT commands from the specified file',crlf));
  673.     call print(@('  all commands except another TAKE command',
  674.                 ' are allowed',crlf));
  675. end take$help;
  676.  
  677. tran$help: procedure;
  678.     call print(@('SYNTAX: TRansmit filespec',crlf));
  679.     call print(@(lf,'Sends a file without KERMIT protocall',crlf));
  680. end tran$help;
  681.  
  682. end cmds;
  683. /*---CONN.P86---*/
  684. $compact
  685. $optimize(3)
  686.  
  687. conn$module:
  688. do;
  689.  
  690. /* CONNECT: Establish a "virtual terminal" connection through a         */
  691. /* specified serial i/o port.  */
  692.  
  693. $INCLUDE(:INC:LTKSEL.LIT)
  694.  
  695. declare status word external;
  696. declare (in$conn,out$conn) token external;
  697. declare (ci$conn,co$conn) token external;
  698. declare debug byte external;
  699.  
  700. declare break literally '1DH';
  701. declare ctly  literally '19H';  /* ^C by typing ^]^Y */
  702. declare ctlq  literally '11H';
  703. declare ctls  literally '13H';
  704. declare ctlc  literally '03H';
  705. declare true  literally '0FFH';
  706. declare false literally '00H';
  707. declare null  literally '0';
  708. declare cr    literally '0DH';
  709. declare lf    literally '0AH';
  710. declare crlf  literally 'cr,lf,null';
  711.  
  712. $INCLUDE(:INC:UREAD.EXT)
  713. $INCLUDE(:INC:UWRITE.EXT)
  714.  
  715. declare iobuff(1024) byte public;
  716.  
  717. check$error: procedure(fatal) byte external;
  718.     declare fatal byte;
  719. end check$error;
  720.  
  721. print:    procedure(msg) external;
  722.     declare msg pointer;
  723. end print;
  724.  
  725. newline: procedure external; end newline;
  726.  
  727. sbreak: procedure byte external;
  728. end sbreak;
  729.  
  730. send$setup: procedure external;
  731. end send$setup;
  732.  
  733. connect:
  734.     procedure public;
  735.     declare (c,i,qbreak) byte;
  736.  
  737.     qbreak=false;
  738.     if debug then
  739.       do;
  740.         call print(@('connecting to serial port $'));
  741. /* something about which terminal line */
  742.         call newline;
  743.         call print(@('to exit CONNECT mode type ^] C$'));
  744.         call newline;
  745.       end;
  746.         do while (1);
  747.         c=DQ$READ(ci$conn,@iobuff,80,@status);
  748.         if check$error(0) then return;
  749. loop:        if c>0 then do;
  750.           if qbreak then do;
  751.             qbreak=false;
  752.             if iobuff(0)='C' then return;
  753.             else if iobuff(0)='c' then return;
  754.             else if iobuff(0)=ctly then iobuff(0)=ctlc;
  755.             else if iobuff(0)='0' then iobuff(0)=null;
  756.             else if iobuff(0)='?' then do;
  757.                 call print(@('Special characters are: B,C,?,^Y,0',crlf));
  758.                 c=c-1;
  759.                 if i>0 then call movb(@iobuff(1),@iobuff(0),c);
  760.                 goto loop;
  761.                 end;
  762.             else if (iobuff(0)='B' or iobuff(0)='b') then do;
  763.                 call send$setup;
  764.                 i=sbreak;
  765.                 c=c-1;
  766.                 if i>0 then call movb(@iobuff(1),@iobuff(0),c);
  767.                 goto loop;
  768.                 end;
  769. /*  add check for other characters.....otherwise ignore */
  770.           end;
  771.           do i=0 to c-1;
  772.             if iobuff(i)=break then do;
  773.               if i>0 then do;
  774.                 call DQ$WRITE(out$conn,@iobuff,i,@status);
  775.                 if check$error(0) then return;
  776.               end;
  777.               c=c-i-1;
  778.               if c>0 then call movb(@iobuff(i+1),@iobuff,c);
  779.               qbreak=true;
  780.               goto loop;
  781.             end;
  782.           end;
  783.           call DQ$WRITE(out$conn,@iobuff,c,@status);
  784.           if check$error(0) then return;
  785.         end;
  786.         c=DQ$READ(in$conn,@iobuff,40,@status);
  787.         if check$error(0) then return;
  788.         if c>0 then do;
  789.           call DQ$WRITE(co$conn,@iobuff,c,@status);
  790.           if check$error(0) then return;
  791.         end;
  792.       end;
  793. end connect;
  794.  
  795. end conn$module;
  796. /*---GET.P86---*/
  797. /* GET: routine to get a file from a remote kermit in server mode
  798.     also includes BYE and FINISH cmds. */
  799. $compact
  800. $optimize(3)
  801.  
  802. get$module:
  803. do;
  804.  
  805. $include(:INC:LTKSEL.LIT)
  806.  
  807. declare true literally '0FFH';
  808. declare false literally '00H';
  809.  
  810. declare null literally '00';
  811. declare cr literally '0DH';
  812. declare lf literally '0AH';
  813. declare crlf literally 'cr,lf,null';
  814. declare myquote literally '023H';
  815. declare chrmsk literally '07FH';
  816.  
  817. declare state byte;
  818. declare tries byte;
  819. declare msgnum byte;
  820. declare maxtry literally '5';
  821.  
  822. declare eol byte;
  823. declare debug byte external;
  824. declare iobuff(1024) byte external;
  825. declare status word external;
  826.  
  827. declare pksize literally '94';
  828. declare send$packet(pksize) byte external;
  829. declare recv$packet(pksize) byte external;
  830. declare count word;
  831. declare oldtry byte;
  832. declare byte$in dword;
  833.  
  834. declare file$conn token external;
  835. declare filename structure
  836.     (len byte,
  837.      name(80) byte) external;
  838. declare qopen byte external;
  839. declare dummy byte;
  840.  
  841. $include(:INC:USWBF.EXT)
  842. $include(:INC:UGTARG.EXT)
  843.  
  844. check$error: procedure(mode) byte external;
  845.     declare mode byte;
  846. end check$error;
  847.  
  848. file$open: procedure(mode) external;
  849.     declare mode byte;
  850. end file$open;
  851.  
  852. file$close: procedure external;
  853. end file$close;
  854.  
  855. co:    procedure(char)external;
  856.     declare char byte;
  857. end co;
  858.  
  859. print:  procedure(string)external;
  860.     declare string pointer;
  861. end print;
  862.  
  863. nout:     procedure(num)external;
  864.     declare num word;
  865. end nout;
  866.  
  867. noutd:     procedure(num)external;
  868.     declare num dword;
  869. end noutd;
  870.  
  871. newline: procedure external; end newline;
  872.  
  873. ctl:    procedure(char) byte external;
  874.     declare char byte;
  875. end ctl;
  876.  
  877. putc: procedure (c,conn) external;
  878.     declare c byte;
  879.     declare conn token;
  880. end putc;
  881.  
  882. do$put: procedure (conn) external;
  883.     declare conn token;
  884. end do$put;
  885.  
  886. spack:     procedure(type, pknum, length, packet) external;
  887.     declare (type, pknum, length) byte;
  888.     declare packet address;
  889. end spack;
  890.  
  891.  
  892. rpack:     procedure(length, pknum, packet) byte external;
  893.     declare (length, pknum, packet) address;
  894. end rpack;
  895.  
  896.  
  897. spar:    procedure (a) external;
  898.     declare a address;
  899. end spar;
  900.  
  901.  
  902. rpar:    procedure (a) external;
  903.     declare a address;
  904. end rpar;
  905.  
  906. rinit:     procedure byte external;
  907. end rinit;
  908.  
  909. rfile:    procedure byte external;
  910. end rfile;
  911.  
  912. rdata:     procedure byte external;
  913. end rdata;
  914.  
  915. recv$setup: procedure external;
  916. end recv$setup;
  917.  
  918. ginit:    procedure byte;
  919.     call spack('R',msgnum,filename.len,.filename.name);
  920.     state=rinit;
  921.     return state;
  922. end ginit;
  923.  
  924. get:   procedure byte public;
  925.  
  926.     if debug then call print(@('Get a file',crlf));
  927.     state = 'R';
  928.     msgnum = 0;
  929.     call recv$setup;
  930.     do while true;
  931.       if state = 'D' then state = rdata;
  932.       else
  933.          if state = 'F' then state = rfile;
  934.          else
  935.             if state = 'R' then state = ginit;
  936.         else
  937.                 if state = 'C' then return true;
  938.             else return false;
  939.     end;
  940. end get;
  941.  
  942. bye: procedure byte public;
  943.     declare (num,length,retc) byte;
  944.     tries=0;
  945.     retc='N';
  946.     msgnum=0;
  947.     do while (retc<>'Y');
  948.         if tries>maxtry then return false;
  949.         call spack('G',msgnum,1,.('L'));
  950.         retc = rpack(.length, .num, .recv$packet);
  951.         tries=tries+1;
  952.     end;
  953.     return true;
  954. end bye;
  955.  
  956. finish: procedure byte public;
  957.     declare (num,length,retc) byte;
  958.     tries=0;
  959.     retc='N';
  960.     msgnum=0;
  961.     do while (retc<>'Y');
  962.         if tries>maxtry then return false;
  963.         call spack('G',msgnum,1,.('F'));
  964.         retc = rpack(.length, .num, .recv$packet);
  965.         tries=tries+1;
  966.     end;
  967.     return true;
  968. end finish;
  969.  
  970. end get$module;
  971. /*---KERMIT.P86---*/
  972. $compact
  973. $optimize(3)
  974. kermit:
  975. do;
  976.  
  977. declare true literally '0FFH';
  978. declare false literally '00H';
  979. $INCLUDE(:INC:LTKSEL.LIT)
  980. $INCLUDE(:INC:NEXCEP.LIT)
  981. $INCLUDE(:INC:IEXCEP.LIT)
  982.  
  983. declare null literally '000H';
  984. declare lf literally '0AH';
  985. declare cr literally '0DH';
  986. declare crlf literally 'cr,lf,null';
  987. declare space literally '20H';
  988. declare dollar literally '24H';
  989. declare soh literally '1';
  990.  
  991. declare term$attr structure
  992.     (num$words        word,
  993.      num$used        word,
  994.      connect$flag    word,
  995.      terminal$flag    word,
  996.      in$baud$rate    word,
  997.      out$baud$rate    word,
  998.      scroll$lines    word,
  999.      x$y$size        word,
  1000.      x$y$offset        word,
  1001.      flow$control    word,
  1002.      high$water$mark word,
  1003.      low$water$mark    word,
  1004.      fc$on$char        word,
  1005.      fc$off$char    word);
  1006. declare fdata structure(
  1007.     len$owner    byte,
  1008.     owner(14)    byte,
  1009.     length        dword,
  1010.     type        byte,
  1011.     owner$access byte,
  1012.     world$access byte,
  1013.     create$time    dword,
  1014.     last$mod$time dword,
  1015.     reserved(20)    byte);
  1016. declare file$len (2) word PUBLIC AT (@fdata.length);
  1017. declare file$truncate byte;
  1018.  
  1019. declare buflen literally '122';
  1020. declare buffer(buflen) byte PUBLIC;
  1021. declare outbuf(buflen) byte;
  1022. declare takebuf(buflen) byte;
  1023. declare cmdstr(buflen) byte PUBLIC;
  1024. declare query_in(10) byte;
  1025. declare outlen word;
  1026. declare trans_wait word public;
  1027. declare status word public;
  1028. declare old_baud_in word;
  1029. declare old_baud_ci word;
  1030. declare dev_attach byte;
  1031. declare server$mode byte public;
  1032. declare baud_rate word PUBLIC;
  1033. declare block_check byte public;
  1034. declare duplex byte PUBLIC;
  1035. declare break_char byte public;
  1036. declare parity byte public;
  1037. declare delim byte public;
  1038. declare len word;
  1039.  
  1040. declare send$delay byte public;
  1041. declare send$eol byte public;
  1042. declare send$paclen byte public;
  1043. declare send$padchar byte public;
  1044. declare send$padding byte public;
  1045. declare send$pause byte public;
  1046. declare send$quote byte public;
  1047. declare send$start byte public;
  1048. declare send$time byte public;
  1049. declare recv$eol byte public;
  1050. declare recv$paclen byte public;
  1051. declare recv$padchar byte public;
  1052. declare recv$padding byte public;
  1053. declare recv$pause byte public;
  1054. declare recv$quote byte public;
  1055. declare recv$start byte public;
  1056. declare recv$time byte public;
  1057. declare send$setup$string(6) byte public;
  1058.  
  1059. declare cmd byte public;
  1060. declare in$conn token public;
  1061. declare out$conn token public;
  1062. declare ci$conn token public;
  1063. declare co$conn token public;
  1064.  
  1065. declare filestr  structure
  1066.     (len byte,
  1067.      name(80) byte);
  1068. declare filename structure
  1069.     (len byte,
  1070.      name(80) byte) public;
  1071. declare file$conn token public;
  1072. declare takename structure
  1073.     (len byte,
  1074.      name(80) byte);
  1075. declare take$conn token;
  1076. declare takelen byte initial (0);
  1077. declare takeindex byte initial (0);
  1078.  
  1079. declare debug byte public;
  1080. declare qopen byte public;
  1081.  
  1082. declare iobuff(1024) byte external;
  1083.  
  1084. /* here are the subroutines */
  1085.  
  1086. $INCLUDE(:INC:HGTIPN.EXT)
  1087. $INCLUDE(:INC:HSTPBF.EXT)
  1088. $INCLUDE(:INC:UFLINF.EXT)
  1089. $INCLUDE(:INC:UATACH.EXT)
  1090. $INCLUDE(:INC:UOPEN.EXT)
  1091. $INCLUDE(:INC:UCLOSE.EXT)
  1092. $INCLUDE(:INC:UWRITE.EXT)
  1093. $INCLUDE(:INC:UDCEX.EXT)
  1094. $INCLUDE(:INC:UCREAT.EXT)
  1095. $INCLUDE(:INC:UDCTIM.EXT)
  1096. $INCLUDE(:INC:UDETAC.EXT)
  1097. $INCLUDE(:INC:ISSPEC.EXT)
  1098. $INCLUDE(:INC:USPECL.EXT)
  1099. $INCLUDE(:INC:USWBF.EXT)
  1100. $INCLUDE(:INC:UREAD.EXT)
  1101. $INCLUDE(:INC:UEXIT.EXT)
  1102. $INCLUDE(:INC:UGTARG.EXT)
  1103. $INCLUDE(:INC:UTRUNC.EXT)
  1104.  
  1105. connect:
  1106.     procedure external;
  1107. end connect;
  1108.  
  1109. spar: procedure (a) external;
  1110.     declare a address;
  1111. end spar;
  1112.  
  1113. rpar: procedure (a) external;
  1114.     declare a address;
  1115. end rpar;
  1116.  
  1117. do$put:    procedure(conn) external;
  1118.     declare conn token;
  1119. end do$put;
  1120.  
  1121. send:     procedure byte external;
  1122. end send;
  1123.  
  1124. bye: procedure byte external;
  1125. end bye;
  1126.  
  1127. finish: procedure byte external;
  1128. end finish;
  1129.  
  1130. get: procedure byte external;
  1131. end get;
  1132.  
  1133. recv:    procedure byte external;
  1134. end recv;
  1135.  
  1136. trans: procedure byte external;
  1137. end trans;
  1138.  
  1139. check$error: PROCEDURE (fatal) byte PUBLIC;
  1140.     declare fatal byte;
  1141.     declare dummy word;
  1142.     declare exc$buf structure(
  1143.         count byte,
  1144.         char(80) byte);
  1145.     if status <> E$OK then do;
  1146.       call DQ$DECODE$EXCEPTION(status,@exc$buf,@dummy);
  1147.       call DQ$WRITE(co$conn,@exc$buf.char,exc$buf.count,@dummy);
  1148.       call DQ$WRITE(co$conn,@(cr,lf),2,@dummy);
  1149.       if fatal<>0 then call exit$cmd(3);
  1150.       return true;
  1151.     end;
  1152.     return false;
  1153. end check$error;
  1154.  
  1155. declare digit word;
  1156. declare numbuf(20) byte;
  1157. declare index byte;
  1158.  
  1159. nout:    procedure(n) public;
  1160.     declare n word;
  1161.  
  1162.     if n = 0 then
  1163.       do;
  1164.         call co('0');
  1165.         return;
  1166.       end;
  1167.     index = 1;
  1168.     do while (n > 0);
  1169.       digit = n mod 10;
  1170.       numbuf(index) = digit+030H;
  1171.       index = index + 1;
  1172.       n = n / 10;
  1173.     end;
  1174.     do while ((index := index - 1) > 0);
  1175.       call co(numbuf(index));
  1176.     end;
  1177. end nout;
  1178.  
  1179. noutd: procedure(n) public;
  1180.     declare n dword;
  1181.  
  1182.     if n = 0 then
  1183.       do;
  1184.         call co('0');
  1185.         return;
  1186.       end;
  1187.     index = 1;
  1188.     do while (n > 0);
  1189.       digit = n mod 10;
  1190.       numbuf(index) = digit+030H;
  1191.       index = index + 1;
  1192.       n = n / 10;
  1193.     end;
  1194.     do while ((index := index - 1) > 0);
  1195.       call co(numbuf(index));
  1196.     end;
  1197. end noutd;
  1198.  
  1199. nin:    procedure(string) address public;
  1200.     declare string address;
  1201.     declare result address;
  1202.     declare c based string byte;
  1203.  
  1204.     result = 0;
  1205.     if (string <> 0) then do;
  1206.       do while (c >= 030H) and (c <= 039H);
  1207.         result = result * 10 + (c - 030H);
  1208.         string = string + 1;
  1209.       end;
  1210.     end;
  1211.     return result;
  1212. end nin;
  1213.  
  1214. co: procedure(c) public;
  1215.     declare c byte;
  1216.     outbuf(outlen)=c;
  1217.     outlen=outlen+1;
  1218.     if outlen>50 then do;
  1219.         call DQ$WRITE(co$conn,@outbuf,outlen,@status);
  1220.         if check$error(1) then return;
  1221.         outlen=0;
  1222.         end;
  1223.     end co;
  1224.  
  1225. do$co: procedure public;
  1226.     if outlen>0 then do;
  1227.         call DQ$WRITE(co$conn,@outbuf,outlen,@status);
  1228.         if check$error(1) then return;
  1229.         outlen=0;
  1230.         end;
  1231.     return;
  1232. end do$co;
  1233.  
  1234. newline: procedure public;
  1235.     outbuf(outlen)=cr;
  1236.     outbuf(outlen+1)=lf;
  1237.     call DQ$WRITE(co$conn,@outbuf,outlen+2,@status);
  1238.     if check$error(1) then return;
  1239.     outlen=0;
  1240. end newline;
  1241.  
  1242. prints:    procedure(msg) public;
  1243.     declare msg pointer;
  1244.     declare buff BASED msg structure
  1245.         (len byte,
  1246.          msg byte);
  1247.     call do$co;
  1248.     call DQ$WRITE(co$conn,@buff.msg,buff.len,@status);
  1249.     if check$error(1) then return;
  1250.     return;
  1251. end prints;
  1252.  
  1253. print:    procedure(msg) public;
  1254.     declare (msg,oldmsg) pointer;
  1255.     declare c based msg (1) byte;
  1256.     declare i word;
  1257.  
  1258.     call do$co;
  1259.     oldmsg=msg;
  1260.     i=0;
  1261.     do while (c(i) > 0) and (c(i) <> '$');
  1262.       if c(i) = '\' then do;
  1263.         if i>0 then do;
  1264.           call DQ$WRITE(co$conn,oldmsg,i,@status);
  1265.           if check$error(1) then return;
  1266.           end;
  1267.         call DQ$WRITE(co$conn,@(cr,lf),2,@status);
  1268.         if check$error(1) then return;
  1269.         oldmsg=@c(i+1);
  1270.         i=0;
  1271.         msg=oldmsg;
  1272.         end;
  1273.       else i=i+1;
  1274.         end;
  1275.     if i>0 then do;
  1276.         call DQ$WRITE(co$conn,oldmsg,i,@status);
  1277.         if check$error(1) then return;
  1278.     end;
  1279. end print;
  1280.  
  1281. set$term$attr: procedure(qdefault);
  1282.     declare qdefault byte;
  1283.     declare c byte;
  1284.     declare save$conn$flag word;
  1285.     declare save$term$flag word;
  1286.     if qdefault then do;
  1287. /* here restore normal terminal attributes */
  1288.       term$attr.connect$flag=save$conn$flag;
  1289.       term$attr.terminal$flag=save$term$flag;
  1290.     end;
  1291.     else do;
  1292. /* here set kermit terminal attributes */
  1293.       save$conn$flag=term$attr.connect$flag;
  1294.       save$term$flag=term$attr.terminal$flag;
  1295.       term$attr.connect$flag=term$attr.connect$flag OR 7;
  1296.       if parity=4 then do;
  1297.         term$attr.connect$flag=term$attr.connect$flag OR 18H;
  1298.         term$attr.terminal$flag=(term$attr.terminal$flag OR 1F0H) xor 0E0H;
  1299.       end;
  1300.       else call print(@('Unsupported parity specified',crlf));
  1301.       if duplex then
  1302.         term$attr.terminal$flag=term$attr.terminal$flag OR 2;
  1303.       else
  1304.         term$attr.terminal$flag=term$attr.terminal$flag AND 0FFFDH;
  1305.     end;
  1306.     call RQ$S$SPECIAL(in$conn,5,@term$attr,0,@status);
  1307.     if check$error(1) then return;
  1308.     if NOT qdefault then do;
  1309. /* PURGE ANY INPUT QUEUED UP */
  1310.       c=1;
  1311.       do while c<>0;
  1312.         c=DQ$READ(in$conn,@iobuff,127,@status);
  1313.         if check$error(1) then return;
  1314.       end;
  1315.     end;
  1316. end set$term$attr;
  1317.  
  1318. get$term$attr: procedure;
  1319.     call RQ$S$SPECIAL(in$conn,4,@term$attr,0,@status);
  1320.     if check$error(1) then return;
  1321.     if debug then do;
  1322.       call print(@('conn_flag ',null));
  1323.       call nout(term$attr.connect$flag);
  1324.       call print(@(' term_flag ',null));
  1325.       call nout(term$attr.terminal$flag);
  1326.       call newline;
  1327.       call print(@('baud rate in/out ',null));
  1328.       call nout(term$attr.in$baud$rate);
  1329.       call co(' ');
  1330.       call nout(term$attr.out$baud$rate);
  1331.       call newline;
  1332.       call print(@('flow control ',null));
  1333.       call nout(term$attr.flow$control);
  1334.       call newline;
  1335.     end;
  1336.     return;
  1337. end get$term$attr;
  1338.  
  1339. /* IOINIT:          */
  1340.  
  1341. ioinit:    procedure;
  1342.     ci$conn=DQ$ATTACH(@(4,':CI:'),@status);
  1343.     co$conn=DQ$ATTACH(@(4,':CO:'),@status);
  1344.     call DQ$OPEN(ci$conn,1,2,@status);
  1345.     call DQ$OPEN(co$conn,2,0,@status);
  1346.     if debug then CALL DQ$WRITE(co$conn,
  1347.                   @('openned consol for I/O',cr,lf),24,@status);
  1348.     in$conn=ci$conn;
  1349.     out$conn=co$conn;
  1350.     call get$term$attr;
  1351.     call print(@('Default communication thru :CI:/:CO:',crlf));
  1352. end ioinit;
  1353.  
  1354. file$open: procedure (mode) PUBLIC;
  1355.     declare mode byte;
  1356.     file$conn=DQ$ATTACH(@filename,@STATUS);
  1357.     file$truncate=false;
  1358.     if mode=2 then do;
  1359.       if status=E$FNEXIST then
  1360.         file$conn=DQ$CREATE(@filename,@status);
  1361.       else if status=E$OK then do;
  1362.         call print(@('About to overwrite file ',null));
  1363.         call prints(@filename);
  1364.         call print(@(', please confirm',null));
  1365.         if NOT query then return;
  1366.         file$truncate=true;
  1367.       end;
  1368.     end;
  1369.     if check$error(0) then return;
  1370.     call DQ$OPEN(file$conn,mode,2,@status);
  1371.     if check$error(0) then return;
  1372.     if mode=1 then do;
  1373.       call DQ$FILE$INFO(file$conn,0,@fdata,@status);
  1374.       if check$error(0) then return;
  1375.     end;
  1376.     qopen=true;
  1377.     return;
  1378. end file$open;
  1379.  
  1380. file$close: procedure public;
  1381.     if qopen then do;
  1382.       if file$truncate then do;
  1383.         call DQ$TRUNCATE(file$conn,@status);
  1384.         if check$error(0) then return;
  1385.       end;
  1386.       call DQ$CLOSE(file$conn,@status);
  1387.       if check$error(0) then return;
  1388.       call DQ$DETACH(file$conn,@status);
  1389.       if check$error(0) then return;
  1390.       qopen=false;
  1391.     end;
  1392. end file$close;
  1393.  
  1394. return$to$ci: procedure;
  1395.    if in$conn <> ci$conn then do;
  1396.      call close$in;
  1397.      in$conn=ci$conn;
  1398.      out$conn=co$conn;
  1399.      call get$term$attr;
  1400.      old_baud_in=term$attr.in$baud$rate;
  1401.      call print(@('set connection via :CI:/:CO:',crlf));
  1402.      if baud_rate<>0 then do;
  1403.       if term$attr.in$baud$rate<>baud_rate then do;
  1404.         call print(@('you are about to change the CI/CO baud rate',
  1405.             ', please confirm:',null));
  1406.         if query then do;
  1407.           term$attr.in$baud$rate=baud_rate;
  1408.           call RQ$S$SPECIAL(in$conn,5,@term$attr,0,@status);
  1409.           if check$error(1) then return;
  1410.         end;
  1411.         else baud_rate=0;
  1412.       end;
  1413.      end;
  1414.    end;
  1415. end return$to$ci;
  1416.  
  1417. close$in: procedure;
  1418.     if baud_rate <> 0 then do;
  1419.       if term$attr.in$baud$rate <> old_baud_in then do;
  1420.         term$attr.in$baud$rate=old_baud_in;
  1421.         call RQ$S$SPECIAL(in$conn,5,@term$attr,0,@status);
  1422.         if check$error(1) then return;
  1423.       end;
  1424.     end;
  1425.     call DQ$CLOSE(in$conn,@status);
  1426.     if check$error(0) then return;
  1427.     call DQ$DETACH(in$conn,@status);
  1428.     if check$error(0) then return;
  1429. end close$in;
  1430.  
  1431. query: procedure byte public;
  1432.     cmd=DQ$READ(ci$conn,@query_in,10,@status);
  1433.     if check$error(0) then return false;
  1434.     if query_in(0)='y' or query_in(0)='Y' then return true;
  1435.     return false;
  1436. end query;
  1437.  
  1438. get$line: procedure byte;
  1439.     declare i byte;
  1440.     len=0;
  1441.     takeindex=takeindex+1;
  1442. loop:
  1443.     if takeindex>=takelen then do;
  1444.         takelen=DQ$READ(take$conn,@takebuf,120,@status);
  1445.         if check$error(0) then return 0;
  1446.         takeindex=0;
  1447.         if takelen=0 then return 0;
  1448.     end;
  1449.     do i=takeindex to takelen-1;
  1450.         buffer(len)=takebuf(i);
  1451.         if debug then call co(takebuf(i));
  1452.         if takebuf(i) <> lf then len=len+1;
  1453.         if takebuf(i)=cr then do;
  1454.             if debug then call do$co;
  1455.             takeindex=i;
  1456.             return len;
  1457.         end;
  1458.     end;
  1459.     takeindex=takelen;
  1460.     goto loop;
  1461. end get$line;
  1462.  
  1463. readln: procedure;
  1464.     declare len word;
  1465.     len=DQ$READ(ci$conn,@buffer,120,@status);
  1466.     if check$error(1) then return;
  1467.     len=DQ$SWITCH$BUFFER(@buffer,@status);
  1468.     if check$error(1) then return;
  1469. end readln;
  1470.  
  1471. bye$cmd: procedure PUBLIC;
  1472.     if in$conn=ci$conn then do;
  1473.       call print(@('can not send bye to yourself...use SET cmd first',
  1474.         crlf));
  1475.       return;
  1476.     end;
  1477.     call set$term$attr(false);
  1478.     if bye then call exit$cmd(3);
  1479.     else call print(@('Error shutting down remote KERMIT',crlf));
  1480.     call set$term$attr(true);
  1481. end bye$cmd;
  1482.  
  1483. conn$cmd: procedure PUBLIC;
  1484.     if delim<>cr then call port$para;
  1485.     if in$conn=ci$conn then do;
  1486.       call print(@('can not connect to yourself...use SET cmd first',
  1487.         crlf));
  1488.       return;
  1489.     end;
  1490.     call DQ$SPECIAL(3,@ci$conn,@status);
  1491.     if check$error(1) then return;
  1492.     call set$term$attr(false);
  1493.     if term$attr.in$baud$rate>4000 then 
  1494.       call print(@('Warning..at present BAUD rate characters',
  1495.             ' will be lost during BURST transmitions',crlf));
  1496.     call connect;
  1497.     call set$term$attr(true);
  1498.     call DQ$SPECIAL(2,@ci$conn,@status);
  1499.     if check$error(1) then return;
  1500.     call newline;
  1501. end conn$cmd;
  1502.  
  1503. def$cmd: procedure PUBLIC;
  1504.     call unsupported;
  1505. end def$cmd;
  1506.  
  1507. exit$cmd: procedure(code) public;
  1508.     declare code byte;
  1509. /* clean up terminal attr. */
  1510.     call DQ$EXIT(code);
  1511. end exit$cmd;
  1512.  
  1513. fin$cmd: procedure PUBLIC;
  1514.     if in$conn=ci$conn then do;
  1515.       call print(@('can not send finish to yourself...use SET cmd first',
  1516.         crlf));
  1517.       return;
  1518.     end;
  1519.     call set$term$attr(false);
  1520.     if NOT finish then
  1521.       call print(@('Error ending remote KERMIT server',crlf));
  1522.     call set$term$attr(true);
  1523. end fin$cmd;
  1524.  
  1525. get$cmd: procedure PUBLIC;
  1526.     if delim = cr then
  1527.         call print(@('No files specified',crlf));
  1528.     else do;
  1529.         delim=DQ$GET$ARGUMENT(@filename,@status);
  1530.         if check$error(0) then return;
  1531. /* HERE IS WHERE YOU SET UP WILDCARD NAMES USING FILESTR */
  1532.         call file$open(2);
  1533.         if qopen then do;
  1534.             call set$term$attr(false);
  1535.             if get then call print(@(cr,lf,'OK',crlf));
  1536.             else call print(@('get failed',crlf));
  1537.             call set$term$attr(true);
  1538.         end;
  1539.         call file$close;
  1540.     end;
  1541. end get$cmd;
  1542.  
  1543. loc$cmd: procedure PUBLIC;
  1544.     call unsupported;
  1545. end loc$cmd;
  1546.  
  1547. log$cmd: procedure PUBLIC;
  1548.     call unsupported;
  1549. end log$cmd;
  1550.  
  1551. recv$cmd: procedure PUBLIC;
  1552.         if delim <> cr then do;
  1553.             delim=DQ$GET$ARGUMENT(@filename,@status);
  1554.             if check$error(0) then return;
  1555.             call file$open(2);
  1556.         end;
  1557.         call set$term$attr(false);
  1558.         if recv then call print(@(cr,lf,'OK',crlf));
  1559.         else call print(@(cr,lf,'error recieving file',crlf));
  1560.         call set$term$attr(true);
  1561.         call do$put(file$conn);
  1562.         call file$close;
  1563. end recv$cmd;
  1564.  
  1565. rem$cmd: procedure PUBLIC;
  1566.     call unsupported;
  1567. end rem$cmd;
  1568.  
  1569. send$cmd: procedure PUBLIC;
  1570.     if delim = cr then
  1571.         call print(@('No files specified',crlf));
  1572.     else do;
  1573.         delim=DQ$GET$ARGUMENT(@filename,@status);
  1574.         if check$error(0) then return;
  1575. /* HERE IS WHERE YOU SET UP WILDCARD NAMES USING FILESTR */
  1576.         call file$open(1);
  1577. /*  add check for output file spec */
  1578.         if qopen then do;
  1579.             call set$term$attr(false);
  1580.             if send then call print(@(cr,lf,'OK',crlf));
  1581.             else call print(@('Send failed',crlf));
  1582.             call set$term$attr(true);
  1583.           end;
  1584.           call file$close;
  1585.         end;
  1586. end send$cmd;
  1587.  
  1588. serv$cmd: procedure PUBLIC;
  1589.     call unsupported;
  1590. end serv$cmd;
  1591.  
  1592. set$cmd: procedure PUBLIC;
  1593.     if delim = cr then
  1594.       call print(@('No parameter specified',crlf));
  1595.     else do;
  1596.       delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  1597.       if check$error(0) then return;
  1598.       call get$para;
  1599.       end;
  1600. end set$cmd;
  1601.  
  1602. get$para: procedure EXTERNAL;
  1603. end get$para;
  1604.  
  1605. get$in$cmd: procedure EXTERNAL;
  1606. end get$in$cmd;
  1607.  
  1608. show$cmd: procedure PUBLIC;
  1609.     call unsupported;
  1610. end show$cmd;
  1611.  
  1612. stat$cmd: procedure PUBLIC;
  1613.     call unsupported;
  1614. end stat$cmd;
  1615.  
  1616. take$cmd: procedure PUBLIC;
  1617.     declare i byte;
  1618.     if delim = cr then
  1619.         call print(@('No file specified',crlf));
  1620.     else do;
  1621.         delim=DQ$GET$ARGUMENT(@takename,@status);
  1622.         if check$error(0) then return;
  1623.         take$conn=DQ$ATTACH(@takename,@STATUS);
  1624.         if check$error(0) then return;
  1625.         call DQ$OPEN(take$conn,1,2,@status);
  1626.         if check$error(0) then return;
  1627. /* here is where you read cmd file, line by line */
  1628.         do while get$line <> 0;
  1629.             i=DQ$SWITCH$BUFFER(@buffer,@status);
  1630.             if check$error(1) then return;
  1631.             delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  1632.             if check$error(0) then return;
  1633.             if cmdstr(0)>0 then call get$in$cmd;
  1634.         end;
  1635.         call DQ$CLOSE(take$conn,@status);
  1636.         if check$error(0) then return;
  1637.         call DQ$DETACH(take$conn,@status);
  1638.         if check$error(0) then return;
  1639.     end;
  1640. end take$cmd;
  1641.  
  1642. tran$cmd: procedure PUBLIC;
  1643.     if delim = cr then
  1644.         call print(@('No files specified',crlf));
  1645.     else do;
  1646.         delim=DQ$GET$ARGUMENT(@filename,@status);
  1647.         if check$error(0) then return;
  1648. /* HERE IS WHERE YOU SET UP WILDCARD NAMES USING FILESTR */
  1649.         call file$open(1);
  1650.       if qopen then do;
  1651.         call print(@('Please enter wait interval between 64',
  1652.             ' byte bursts',crlf));
  1653.         call readln;
  1654.         delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  1655.         if check$error(0) then return;
  1656.         cmdstr(cmdstr(0))=delim;
  1657.         trans_wait=nin(.cmdstr(1));
  1658.         call set$term$attr(false);
  1659.         if trans then call print(@(cr,lf,'OK',crlf));
  1660.         else call print(@('Transmit failed',crlf));
  1661.         call set$term$attr(true);
  1662.       end;
  1663.       call file$close;
  1664.     end;
  1665. end tran$cmd;
  1666.  
  1667. ambiguous: procedure EXTERNAL;
  1668. end ambiguous;
  1669.  
  1670. unsupported: procedure EXTERNAL;
  1671. end unsupported;
  1672.  
  1673. unknown: procedure(cmd$ptr) EXTERNAL;
  1674.     declare cmd$ptr pointer;
  1675. end unknown;
  1676.  
  1677. do$cmd: procedure EXTERNAL;
  1678. end do$cmd;
  1679.  
  1680. do$para: procedure EXTERNAL;
  1681. end do$para;
  1682.  
  1683. get$baud: procedure EXTERNAL;
  1684. end get$baud;
  1685.  
  1686. get$duplex: procedure EXTERNAL;
  1687. end get$duplex;
  1688.  
  1689. output$baud: procedure EXTERNAL;
  1690. end output$baud;
  1691.  
  1692. baud$para: procedure PUBLIC;
  1693.     if delim=cr then do;
  1694.       baud_rate=0;
  1695.     end;
  1696.     else do;
  1697.       delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  1698.       if check$error(0) then return;
  1699.       call get$baud;
  1700.       if cmd<=0 then return;
  1701.       if in$conn=ci$conn then do;
  1702.         call print(@('about to change consol baud rate to ',null));
  1703.         call output$baud;
  1704.         call print(@(', please confirm:',null));
  1705.         if NOT query then return;
  1706.       end;
  1707.     end;
  1708.     if baud_rate=0 then term$attr.in$baud$rate=old_baud_in;
  1709.     else term$attr.in$baud$rate=baud_rate;
  1710.     call RQ$S$SPECIAL(in$conn,5,@term$attr,@buffer,@status);
  1711.     if check$error(1) then return;
  1712. end baud$para;
  1713.  
  1714. block$para: procedure PUBLIC;
  1715.     call unsupported;
  1716. end block$para;
  1717.  
  1718. debug$para: procedure PUBLIC;
  1719.     debug= NOT debug;
  1720.     if debug then call print(@('DEBUG ON',crlf));
  1721.     else call print(@('DEBUG OFF',crlf));
  1722. end debug$para;
  1723.  
  1724. delay$para: procedure PUBLIC;
  1725.     if delim=cr then send$delay=5;
  1726.     else do;
  1727.       delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  1728.       if check$error(0) then return;
  1729.       cmdstr(cmdstr(0))=delim;
  1730.       send$delay=nin(.cmdstr(1));
  1731.     end;
  1732. end delay$para;
  1733.  
  1734. dup$para: procedure PUBLIC;
  1735.     if delim=cr then duplex=0;
  1736.     else do;
  1737.       delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  1738.       if check$error(0) then return;
  1739.       call get$duplex;
  1740.     end;
  1741. end dup$para;
  1742.  
  1743. esc$para: procedure PUBLIC;
  1744.     call unsupported;
  1745. end esc$para;
  1746.  
  1747. file$para: procedure PUBLIC;
  1748.     call unsupported;
  1749. end file$para;
  1750.  
  1751. flow$para: procedure PUBLIC;
  1752.     call unsupported;
  1753. end flow$para;
  1754.  
  1755. hand$para: procedure PUBLIC;
  1756.     call unsupported;
  1757. end hand$para;
  1758.  
  1759. ibm$para: procedure PUBLIC;
  1760.     call unsupported;
  1761. end ibm$para;
  1762.  
  1763. inco$para: procedure PUBLIC;
  1764.     call unsupported;
  1765. end inco$para;
  1766.  
  1767. par$para: procedure PUBLIC;
  1768.     call unsupported;
  1769. end par$para;
  1770.  
  1771. port$para: procedure PUBLIC;
  1772.     if delim=cr then call return$to$ci;
  1773.     else do;
  1774.       delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  1775.       if check$error(0) then return;
  1776.       if cmdstr(0)<>4 or (CMPB(@cmdstr(1),@(':CI:'),4)<>-1
  1777.           and CMPB(@cmdstr(1),@(':CO:'),4)<>-1) then do;
  1778.         if in$conn <> ci$conn then call close$in;
  1779.         in$conn=DQ$ATTACH(@cmdstr,@status);
  1780.         if check$error(0) then return;
  1781.         call DQ$OPEN(in$conn,3,0,@status);
  1782.         if check$error(0) then return;
  1783.         out$conn=in$conn;
  1784.         call get$term$attr;
  1785.         old_baud_in=term$attr.in$baud$rate;
  1786.         if baud_rate <> 0 then do;
  1787. /*  set new terminal to requested baud rate */
  1788.         end;
  1789.         call print(@('set connection via ',null));
  1790.         call prints(@cmdstr);
  1791.         call newline;
  1792.       end;
  1793.       else call return$to$ci;
  1794.     end;
  1795.     call get$term$attr;
  1796. end port$para;
  1797.  
  1798. recv$para: procedure PUBLIC;
  1799.     call unsupported;
  1800. end recv$para;
  1801.  
  1802. retry$para: procedure PUBLIC;
  1803.     call unsupported;
  1804. end retry$para;
  1805.  
  1806. send$para: procedure PUBLIC;
  1807.     call unsupported;
  1808. end send$para;
  1809.  
  1810. /* *** main program *** */
  1811.  
  1812. outlen=0;
  1813. debug = false;
  1814. server$mode=false;
  1815. dev_attach=false;
  1816. qopen = false;
  1817. send$delay=5;
  1818. send$eol=cr;       recv$eol=cr;
  1819. send$paclen=94;      recv$paclen=94;
  1820. send$padchar=0;      recv$padchar=0;
  1821. send$padding=0;      recv$padding=0;
  1822. send$pause=1;      recv$pause=1;
  1823. send$quote=23H;      recv$quote=23H;
  1824. send$start=soh;      recv$start=soh;
  1825. send$time=5;      recv$time=5;
  1826. baud_rate=0;    /* use system default */
  1827. block_check=1; /* simple check-sum */
  1828. duplex=0;        /* 0=FULL, 1=HALF */
  1829. break_char=1DH; /* default ^] */
  1830. parity=4;        /* parity code 0, set to 0 on output
  1831.                               ignore on input, but clear bit 7
  1832.                            1, set to 1 on output
  1833.                               ignore on input, but clear bit 7
  1834.                            2, even parity in and out
  1835.                            3, odd  parity in and out
  1836.                            4, 8-bit...do not check or change bit 7 */
  1837. term$attr.num$words=5;
  1838. term$attr.num$used=5;
  1839. call spar(.send$setup$string);
  1840. call rpar(.send$setup$string);
  1841.  
  1842. call ioinit;
  1843.  
  1844. old_baud_ci=term$attr.in$baud$rate;
  1845. old_baud_in=0;
  1846.  
  1847. call print(@('RMX-86 Kermit Version 1.0',crlf));
  1848.  
  1849. do while (true);
  1850.     call print(@('Kermit-RMX>',null));
  1851.     call readln;
  1852.     delim=DQ$GET$ARGUMENT(@cmdstr,@status);
  1853.     if check$error(1) then call exit$cmd(3);
  1854.     if cmdstr(0)>0 then call get$in$cmd;
  1855. end;
  1856.  
  1857. end kermit;
  1858. /*---RECV.P86---*/
  1859. /* RECEIVE: Routines for reading from the console and the serial ports */
  1860. $compact
  1861. $optimize(3)
  1862.  
  1863. recv$module:
  1864. do;
  1865.  
  1866. $include(:INC:LTKSEL.LIT)
  1867.  
  1868. declare true literally '0FFH';
  1869. declare false literally '00H';
  1870.  
  1871. declare null literally '00';
  1872. declare cr literally '0DH';
  1873. declare lf literally '0AH';
  1874. declare crlf literally 'cr,lf,null';
  1875. declare myquote literally '023H';
  1876. declare chrmsk literally '07FH';
  1877.  
  1878. declare state byte;
  1879. declare tries byte;
  1880. declare msgnum byte;
  1881. declare maxtry literally '5';
  1882.  
  1883. declare eol byte;
  1884. declare debug byte external;
  1885. declare iobuff(1024) byte external;
  1886. declare status word external;
  1887.  
  1888. declare pksize literally '94';
  1889. declare send$packet(pksize) byte external;
  1890. declare recv$packet(pksize) byte external;
  1891. declare count word;
  1892. declare oldtry byte;
  1893. declare byte$in dword;
  1894.  
  1895. declare file$conn token external;
  1896. declare filename structure
  1897.     (len byte,
  1898.      name(80) byte) external;
  1899. declare qopen byte external;
  1900. declare dummy byte;
  1901.  
  1902. $include(:INC:USWBF.EXT)
  1903. $include(:INC:UGTARG.EXT)
  1904.  
  1905. check$error: procedure(mode) byte external;
  1906.     declare mode byte;
  1907. end check$error;
  1908.  
  1909. file$open: procedure(mode) external;
  1910.     declare mode byte;
  1911. end file$open;
  1912.  
  1913. file$close: procedure external;
  1914. end file$close;
  1915.  
  1916. co:    procedure(char)external;
  1917.     declare char byte;
  1918. end co;
  1919.  
  1920. print:  procedure(string)external;
  1921.     declare string pointer;
  1922. end print;
  1923.  
  1924. nout:     procedure(num)external;
  1925.     declare num word;
  1926. end nout;
  1927.  
  1928. noutd:     procedure(num)external;
  1929.     declare num dword;
  1930. end noutd;
  1931.  
  1932. newline: procedure external; end newline;
  1933.  
  1934. ctl:    procedure(char) byte external;
  1935.     declare char byte;
  1936. end ctl;
  1937.  
  1938. putc: procedure (c,conn) external;
  1939.     declare c byte;
  1940.     declare conn token;
  1941. end putc;
  1942.  
  1943. do$put: procedure (conn) external;
  1944.     declare conn token;
  1945. end do$put;
  1946.  
  1947. spack:     procedure(type, pknum, length, packet) external;
  1948.     declare (type, pknum, length) byte;
  1949.     declare packet address;
  1950. end spack;
  1951.  
  1952.  
  1953. rpack:     procedure(length, pknum, packet) byte external;
  1954.     declare (length, pknum, packet) address;
  1955. end rpack;
  1956.  
  1957.  
  1958. spar:    procedure (a) external;
  1959.     declare a address;
  1960. end spar;
  1961.  
  1962.  
  1963. rpar:    procedure (a) external;
  1964.     declare a address;
  1965. end rpar;
  1966.  
  1967.  
  1968. bufemp:    procedure(packet, len);
  1969.     declare packet address;
  1970.     declare inchar based packet byte;
  1971.     declare (i, char, len) byte;
  1972.  
  1973.     if debug then call print(@('Writing to disk...',null));
  1974.     i = 0;
  1975.     do while (i < len);
  1976.       char  = inchar;
  1977.       if char = myquote then do;
  1978.         packet = packet + 1;
  1979.         i = i + 1;
  1980.         char = inchar;
  1981.         if (char and chrmsk) <> myquote then char = ctl(char);
  1982.       end;
  1983.       if debug then call co(char);
  1984.       call putc(char,file$conn);
  1985.       packet = packet + 1;
  1986.       byte$in=byte$in+1;
  1987.       i = i + 1;
  1988.     end;
  1989.     if debug then call newline;
  1990.     call do$put(file$conn);
  1991. end bufemp;
  1992.  
  1993.  
  1994. rinit:     procedure byte public;
  1995.     declare (len, num, retc) byte;
  1996.  
  1997.     if tries > maxtry then return 'A';
  1998.     else tries = tries + 1;
  1999.  
  2000.     if debug then call print(@('rinit...',crlf));
  2001.  
  2002.     retc = rpack(.len, .num, .recv$packet);
  2003.     if (retc <> 'S') then return state;
  2004.     /* here on send init received */
  2005.     call rpar(.recv$packet);
  2006.     call spar(.send$packet);
  2007.     call spack('Y', msgnum, 6, .send$packet);
  2008.     oldtry = tries;
  2009.     tries = 0;
  2010.     byte$in=0;
  2011.     msgnum = (msgnum + 1) mod 64;
  2012.     return 'F';
  2013. end rinit;
  2014.  
  2015.  
  2016. rfile:    procedure byte public;
  2017.     declare (len, num, retc) byte;
  2018.  
  2019.     if tries > maxtry then return 'A';
  2020.     else tries = tries + 1;
  2021.  
  2022.     if debug then call print(@('rfile...',crlf));
  2023.  
  2024.     retc = rpack(.len, .num, .recv$packet);
  2025.  
  2026.     if retc = 'S' then do;
  2027.       if (oldtry > maxtry) then return 'A';
  2028.         else oldtry = oldtry + 1;
  2029.       if (num = msgnum - 1) then
  2030.         do;
  2031.           call spar(.send$packet);
  2032.            call spack('Y', num, 6 , .send$packet);
  2033.           tries = 0;
  2034.           return state;
  2035.         end;
  2036.       else return 'A';
  2037.     end;
  2038.  
  2039.     if retc = 'Z' then do;
  2040.       if (oldtry > maxtry) then return 'A';
  2041.         else oldtry = oldtry + 1;
  2042.       if (num = msgnum - 1) then
  2043.         do;
  2044.           call spack('Y', num, 0, 0);
  2045.           tries = 0;
  2046.           return state;
  2047.         end;
  2048.       else return 'A';
  2049.     end;
  2050.  
  2051.     if retc = 'F' then do;
  2052.       if (num <> msgnum) then return 'A';
  2053.       call print(@(cr,lf,'Receiving ',null));
  2054.       call print(@recv$packet);
  2055.       call newline;
  2056.       if not qopen then do;
  2057.         dummy=DQ$SWITCH$BUFFER(@recv$packet,@status);
  2058.         if check$error(0) then return 'A';
  2059.         dummy=DQ$GET$ARGUMENT(@filename,@status);
  2060.         if check$error(0) then return 'A';
  2061.         call file$open(2);
  2062.       end;
  2063.       if not qopen then return 'A';
  2064.       call spack('Y', msgnum, 0, 0);
  2065.       oldtry = tries;
  2066.       tries = 0;
  2067.       msgnum = (msgnum + 1) mod 64;
  2068.       return 'D';
  2069.     end;
  2070.  
  2071.     if retc = 'B' then do;
  2072.       if (num <> msgnum) then return 'A';
  2073.       call spack('Y', msgnum, 0, 0);
  2074.       return 'C';
  2075.     end;
  2076.  
  2077.     return state;
  2078. end rfile;
  2079.  
  2080.  
  2081.  
  2082. rdata:     procedure byte public;
  2083.     declare (num, len, retc) byte;
  2084.  
  2085.     if tries > maxtry then return 'A';
  2086.       else tries = tries + 1;
  2087.  
  2088.     if debug then call print(@('rdata...',crlf));
  2089.  
  2090.     retc = rpack(.len, .num, .recv$packet);
  2091.  
  2092.     if retc = 'D' then do;
  2093.       if (num <> msgnum) then do;
  2094.         if (oldtry > maxtry) then return 'A';
  2095.           else oldtry = oldtry + 1;
  2096.         if (num = msgnum - 1) then do;
  2097.           call spar(.send$packet);
  2098.           call spack('Y', num, 6, .send$packet);
  2099.           tries = 0;
  2100.           return state;
  2101.         end;
  2102.         else return 'A';
  2103.       end;
  2104.       call bufemp(.recv$packet, len);
  2105.       call spack('Y', msgnum, 0, 0);
  2106.       oldtry = tries;
  2107.       tries = 0;
  2108.         call print(@('recieved ',null));
  2109.         call noutd(byte$in);
  2110.         call print(@(' bytes ',cr,null));
  2111.       msgnum = (msgnum + 1) mod 64;
  2112.       return 'D';
  2113.       end;
  2114.  
  2115.     if retc = 'F' then do;
  2116.       if (oldtry > maxtry) then return 'A';
  2117.         else oldtry = oldtry + 1;
  2118.       if (num = msgnum - 1) then
  2119.         do;
  2120.           call spack('Y', num, 0, 0);
  2121.           tries = 0;
  2122.           return state;
  2123.         end;
  2124.       else return 'A';
  2125.     end;
  2126.  
  2127.     if retc = 'Z' then do;
  2128.       if (num <> msgnum) then return 'A';
  2129.       call spack('Y', msgnum, 0, 0);
  2130.       call file$close;
  2131.       msgnum = (msgnum + 1) mod 64;
  2132.       return 'F';
  2133.     end;
  2134.  
  2135.     call spack('N', msgnum, 0, 0);
  2136.     return state;
  2137. end rdata;
  2138.  
  2139. recv$setup: procedure public;
  2140.     state = 'R';
  2141.     msgnum = 0;
  2142.     tries = 0;
  2143.     oldtry = 0;
  2144. end recv$setup;
  2145.  
  2146. recv:   procedure byte public;
  2147.  
  2148.     if debug then call print(@('Receive a file',crlf));
  2149.     call recv$setup;
  2150.     do while true;
  2151.       if state = 'D' then state = rdata;
  2152.       else
  2153.          if state = 'F' then state = rfile;
  2154.          else
  2155.             if state = 'R' then state = rinit;
  2156.         else
  2157.                 if state = 'C' then return true;
  2158.             else return false;
  2159.     end;
  2160. end recv;
  2161.  
  2162. end recv$module;
  2163. /*---SEND.P86---*/
  2164. /* SEND MODULE: this module handles all sending of data between the    */
  2165. /* host and RMX system                        */
  2166. $compact
  2167. $optimize(3)
  2168.  
  2169. send$module:
  2170. do;
  2171.  
  2172. $INCLUDE(:INC:LTKSEL.LIT)
  2173. $INCLUDE(:INC:UREAD.EXT)
  2174. $INCLUDE(:INC:UWRITE.EXT)
  2175. $INCLUDE(:INC:UDCTIM.EXT)
  2176. $INCLUDE(:INC:NSLEEP.EXT)
  2177.  
  2178. /* here are some global declarations for the communication module */
  2179.  
  2180. declare true literally '0FFH';
  2181. declare false literally '00H';
  2182.  
  2183. declare chrmsk literally '07FH';
  2184. declare maxtry literally '05';
  2185. declare space literally '020H';
  2186. declare cr literally '0DH';
  2187. declare lf literally '0AH';
  2188. declare null literally '00H';
  2189. declare crlf literally 'cr,lf,null';
  2190. declare eofl literally '0';
  2191. declare delete literally '07FH';
  2192.  
  2193. declare send$delay byte external;
  2194. declare send$eol byte external;
  2195. declare send$paclen byte external;
  2196. declare send$padchar byte external;
  2197. declare send$padding byte external;
  2198. declare send$pause byte external;
  2199. declare send$quote byte external;
  2200. declare send$start byte external;
  2201. declare send$time byte external;
  2202.  
  2203. declare readonly literally '1';
  2204. declare writeonly literally '2';
  2205. declare rdwr literally '3';
  2206. declare noedit literally '0';
  2207.  
  2208. declare pksize literally '94';
  2209. declare send$packet(pksize) byte public;    /* buffer for packets */
  2210. declare recv$packet(pksize) byte public;    /* buffer for packets */
  2211.  
  2212. declare send_delay word;
  2213. declare state byte;            /* FSM last state */
  2214. declare msgnum byte;            /* message number */
  2215. declare tries byte;            /* max number of retries */
  2216. declare numpads byte;            /* how many pads to send */
  2217. declare padchar byte;            /* the present pad character */
  2218. declare eol byte;            /* the present eol character */
  2219. declare quote byte;            /* the present quote character */
  2220. declare timeint byte;            /* the present time out */
  2221. declare spsize byte;            /* the present packet size */
  2222. declare pklen word;
  2223. declare (j,count) word initial (0,0);
  2224. declare (k,cnt)   word initial (0,0);
  2225. declare buflen literally '128';
  2226. declare inbuf (buflen) byte;
  2227. declare outbuf(buflen) byte;
  2228. declare outlen word initial (0);
  2229.  
  2230. declare (in$conn,out$conn) token external;
  2231. declare (ci$conn,co$conn) token external;
  2232. declare status word external;
  2233. declare debug byte external;
  2234. declare file$conn token external;
  2235. declare iobuff(1024) byte external;
  2236. declare file$len (2) word external;
  2237. declare byte$out dword;
  2238. declare byte$tot dword at (@file$len);
  2239. declare frac$tot word;
  2240. declare filename structure
  2241.     (len byte,
  2242.      name(80) byte) external;
  2243. declare wait$time byte public;
  2244. declare system$end$time dword public;
  2245. declare time$buffer structure
  2246.     (system$time    dword,
  2247.      date(8)        byte,
  2248.      time(8)        byte);
  2249.  
  2250. /* here are the subroutines */
  2251.  
  2252. check$error: procedure (fatal) byte external;
  2253.     declare fatal byte;
  2254. end check$error;
  2255.  
  2256. co:    procedure(char) external;
  2257.     declare char byte;
  2258. end co;
  2259.  
  2260. prints:    procedure(msg) external;
  2261.     declare msg pointer;
  2262. end prints;
  2263.  
  2264. print:     procedure(string) external;
  2265.     declare string pointer;
  2266. end print;
  2267.  
  2268. nout:     procedure(n) external;
  2269.     declare n word;
  2270. end nout;
  2271.  
  2272. noutd:     procedure(n) external;
  2273.     declare n dword;
  2274. end noutd;
  2275.  
  2276. file$open: procedure (mode) external;
  2277.     declare mode byte;
  2278. end file$open;
  2279.  
  2280. newline: procedure external; end newline;
  2281.  
  2282. /* TOCHAR: takes a character and converts it to a printable character      */
  2283. /*         by adding a space                        */
  2284.  
  2285. tochar: procedure(char) byte public;
  2286.     declare char byte;
  2287.     return (char + space);
  2288. end tochar;
  2289.  
  2290.  
  2291. /* UNCHAR: undoes 'tochar' */
  2292.  
  2293. unchar:    procedure(char) byte public;
  2294.     declare char byte;
  2295.     return (char - space);
  2296. end unchar;
  2297.  
  2298.  
  2299. /* CTL: this routine takes a character and toggles the control bit    */
  2300. /* (ie. ^A becomes A and A becomes ^A).                    */
  2301.  
  2302. ctl:     procedure(char) byte public;
  2303.     declare char byte;
  2304.     declare cntrlbit literally '040H';
  2305.     return (char xor cntrlbit);
  2306. end ctl;
  2307.  
  2308. getc: procedure (conn) byte public;
  2309.     declare conn token;
  2310.     if debug then call print(@('Entering getc...',crlf));
  2311.     k=k+1;
  2312. loop:
  2313.     if k>=cnt then do;
  2314.       cnt=DQ$READ(conn,@inbuf,buflen,@status);
  2315.       if check$error(0) then wait$time = 0;
  2316.       k=0;
  2317.         if debug then call print(@('back from reading...',crlf));
  2318.       if cnt=0 then call chk$time;
  2319.       if wait$time=0 then return 0;
  2320.         if debug then call print(@('looping back to read again',crlf));
  2321.       goto loop;
  2322.     end;
  2323.     return inbuf(k);
  2324. end getc;
  2325.  
  2326. putc: procedure (c, conn) public;
  2327.     declare c byte;
  2328.     declare conn token;
  2329.     outbuf(outlen)=c;
  2330.     outlen=outlen+1;
  2331.     if outlen>=buflen then call do$put(conn);
  2332. end putc;
  2333.  
  2334. do$put: procedure (conn) public;
  2335.     declare conn token;
  2336.     if outlen>0 then do;
  2337.       call DQ$WRITE(conn,@outbuf,outlen,@status);
  2338.       if check$error(0) then return;
  2339.       outlen=0;
  2340.     end;
  2341. end do$put;
  2342.  
  2343. set$end$time: procedure (wait) public;
  2344.     declare wait byte;
  2345.     time$buffer.system$time=0;
  2346.     call DQ$DECODE$TIME(@time$buffer,@status);
  2347.     if check$error(1) then return;
  2348.     wait$time=wait;
  2349.     system$end$time=time$buffer.system$time +
  2350.                     double(double(wait));
  2351.     if debug then do;
  2352.         call print(@('wait_time=',null));
  2353.         call nout(wait$time);
  2354.         call print(@('  from end_time=',null));
  2355.         call noutd(system$end$time);
  2356.         call print(@('  and now_time=',null));
  2357.         call noutd(time$buffer.system$time);
  2358.         call newline;
  2359.     end;
  2360. end set$end$time;
  2361.  
  2362. chk$time: procedure public;
  2363.     if debug then call print(@(' enter chk_time...',crlf));
  2364.     call RQ$SLEEP(10,@status); /* add wait a little? */
  2365.     if check$error(1) then return;
  2366.     time$buffer.system$time=0;
  2367.     call DQ$DECODE$TIME(@time$buffer,@status);
  2368.     if check$error(1) then return;
  2369.     if time$buffer.system$time>system$end$time then wait$time=0;
  2370.     else wait$time=system$end$time-time$buffer.system$time;
  2371.     if debug then do;
  2372.         call print(@('wait_time=',null));
  2373.         call nout(wait$time);
  2374.         call print(@('  from end_time=',null));
  2375.         call noutd(system$end$time);
  2376.         call print(@('  and now_time=',null));
  2377.         call noutd(time$buffer.system$time);
  2378.         call newline;
  2379.     end;
  2380.     return;
  2381. end chk$time;
  2382.  
  2383. spar:     procedure (a) public;
  2384.     declare a address;
  2385.     declare b based a byte;
  2386.     b = tochar(send$paclen);        /* set up header */
  2387.     a = a + 1;
  2388.     b = tochar(send$time);
  2389.     a = a + 1;
  2390.     b = tochar(send$padding);
  2391.     a = a + 1;
  2392.     b = ctl(send$padchar);
  2393.     a = a + 1;
  2394.     b = tochar(send$eol);
  2395.     a = a + 1;
  2396.     b = send$quote;
  2397. end spar;
  2398.  
  2399.  
  2400. rpar:    procedure (addr) public;
  2401.     declare addr address;
  2402.     declare item based addr byte;
  2403.  
  2404.     spsize = unchar(item);        /* isn't plm wonderful? */
  2405.     addr = addr + 1;
  2406.     timeint = unchar(item);
  2407.     addr = addr + 1;
  2408.     numpads = unchar(item);
  2409.     addr = addr + 1;
  2410.     padchar = ctl(item);
  2411.     addr = addr + 1;
  2412.         eol = unchar(item);
  2413.     addr = addr + 1;
  2414.     quote = item;
  2415. end rpar;
  2416.  
  2417.  
  2418. bufill:    procedure (packet) byte;
  2419.     declare packet address;
  2420.     declare (pp, maxpp) address;
  2421.     declare done byte;
  2422.     declare chr based pp byte;
  2423.     declare i word;
  2424.  
  2425.     done = false;
  2426.     pp = packet;
  2427.     maxpp = pp + spsize - 8;
  2428.     do while not done;
  2429.       if j>=count then do;
  2430.         count = DQ$READ(file$conn,@iobuff,512,@status);
  2431.         if status > 0 then do;
  2432.           call print(@('Error reading file',crlf));
  2433.           if check$error(0) then return 0;
  2434.         end;
  2435.         if count = 0 then done = true;
  2436.         j=0;
  2437.       end;
  2438.       else do;
  2439.       do i=j to count-1;
  2440.         if ((iobuff(i) and chrmsk) < space) or
  2441.         ((iobuff(i) and chrmsk) = delete) then
  2442.           do;
  2443.         chr = quote;
  2444.         pp = pp + 1;
  2445.         chr = ctl(iobuff(i));
  2446.           end;
  2447.         else
  2448.           if (iobuff(i) and chrmsk) = quote then
  2449.         do;
  2450.           chr = quote;
  2451.           pp = pp + 1;
  2452.           chr = iobuff(i);
  2453.         end;
  2454.           else
  2455.         chr = iobuff(i);
  2456.         pp = pp + 1;
  2457.         byte$out=byte$out+1;
  2458.         if pp >= maxpp then do;
  2459.           j = i+1;
  2460.           return (pp-packet);
  2461.         end;
  2462.       end;
  2463.       j=count+1;
  2464.       end;
  2465.     end;
  2466.     return (pp - packet);
  2467. end bufill;
  2468.  
  2469.  
  2470. /* SPACK: this routine sends a packet of data to the host, it takes    */
  2471. /* four parameters, the type of packet, message number, packet length   */
  2472. /* and a pointer to a buffer containing what is to be output. It does    */
  2473. /* not return a value.                            */
  2474.  
  2475. spack:    procedure(type, pknum, length, packet) public;
  2476.     declare (type, pknum, length) byte;
  2477.     declare packet address;
  2478.     declare char based packet byte;
  2479.     declare (i, chksum) byte;
  2480.  
  2481.     if debug then do;
  2482.       call print(@('Sending packet ',null));
  2483.       call nout(pknum);
  2484.       call newline;
  2485.     end;
  2486.  
  2487.     i = 1;                    /* do padding */
  2488.     do while (i <= numpads);
  2489.       call putc(padchar, out$conn);
  2490.       i = i + 1;
  2491.     end;
  2492.  
  2493.     chksum = 0;
  2494.     /* send the packet header */
  2495.  
  2496.     call putc(send$start, out$conn);        /* send packet marker (soh) */
  2497.     if debug then call co('s');
  2498.     i = tochar(length + 3);
  2499.     chksum = i;
  2500.     call putc(i, out$conn);            /* send character count     */
  2501.     if debug then call co('c');
  2502.     i = tochar(pknum);
  2503.     chksum = chksum + i;            /* add in packet number     */
  2504.     call putc(i, out$conn);            /* send packet number        */
  2505.     if debug then call co('n');
  2506.     chksum = chksum + type;            /* add in packet type        */
  2507.     call putc(type, out$conn);            /* send the packet type        */
  2508.     if debug then call co(type);
  2509.  
  2510.     /* now send the data */
  2511.     do i = 1 to length;
  2512.       chksum = chksum + char;
  2513.       call putc(char, out$conn);
  2514.       if debug then call co(char);
  2515.       packet = packet + 1;
  2516.     end;
  2517.  
  2518.     /* check sum generation */
  2519.  
  2520.     chksum = ((chksum + (chksum and 192) / 64) and 63);
  2521.     chksum = tochar(chksum);
  2522.     call putc(chksum, out$conn);        /* send the chksum */
  2523.     if debug then call co('c');
  2524.  
  2525.     call putc(eol, out$conn);            /* terminate the packet */
  2526.     if debug then do;
  2527.       call co('e');
  2528.       call newline;
  2529.     end;
  2530.     call do$put(out$conn);
  2531. end spack;
  2532.  
  2533.  
  2534. /* RPACK: this routine receives a packet from the host.  It takes three    */
  2535. /* parameters: the address of where to put the length of the packet,    */
  2536. /* the address of where to put the packet number and the address of the */
  2537. /* buffer to recieve the data.  It returns true for a positive reply or */
  2538. /* false for a NEGative reply.                        */
  2539.  
  2540. rpack:     procedure(length, pknum, packet) byte public;
  2541.     declare (length, pknum, packet, pkptr) address;
  2542.  
  2543.     declare len based length byte;
  2544.     declare num based pknum byte;
  2545.     declare pk based pkptr byte;
  2546.     declare (i, index, chksum, hischksum, type, inchar, msglen) byte;
  2547.  
  2548.     declare buffer(128) byte;
  2549.  
  2550.     if debug then call print(@('rpack | ',null));
  2551.  
  2552.     inchar = 0;            /* wait for a header */
  2553.     call set$end$time(send$time);
  2554.     do while inchar <> send$start;
  2555.       inchar = getc(in$conn);
  2556.       if wait$time=0 then return 'N';
  2557.     end;
  2558.     index = 0;
  2559.     call set$end$time(send$time);
  2560.     inchar = getc(in$conn);
  2561.       if wait$time=0 then return 'N';
  2562.     do while (inchar <> send$eol);
  2563.       buffer(index) = inchar;
  2564.       index = index + 1;
  2565.       inchar = getc(in$conn);
  2566.       if wait$time=0 then return 'N';
  2567.     end;
  2568.     buffer(index) = null;
  2569.     if debug then do;
  2570.     call print(@('Received packet: [',null));
  2571.     call print(@buffer);
  2572.     call print(@(']',cr,lf,'Length of message: ',null));
  2573.     end;
  2574.     msglen = index - 1;
  2575.     if debug then do;
  2576.     call nout(msglen);
  2577.     call newline;
  2578.     call print(@('Length field: ',null));
  2579.     call nout(buffer(0));
  2580.     call co('_');
  2581.     end;
  2582.     len = unchar(buffer(0)-3);
  2583.     if debug then do;
  2584.     call nout(len);
  2585.     call print(@(cr,lf,'Message number: ',null));
  2586.     call nout(buffer(1));
  2587.     call co('_');
  2588.     end;
  2589.     num = unchar(buffer(1));
  2590.     if debug then do;
  2591.     call nout(num);
  2592.     call print(@(cr,lf,'Type: ',null));
  2593.     end;
  2594.     type = buffer(2);
  2595.     if debug then do;
  2596.     call co(type);
  2597.     call newline;
  2598.     end; /* debug */
  2599.  
  2600.     pkptr = packet;
  2601.     chksum = buffer(0) + buffer(1) + buffer(2);
  2602.  
  2603.     i = 3;                /* index of first data character */
  2604.     do while (i < msglen);
  2605.       chksum = (pk := buffer(i)) + chksum;
  2606.       pkptr = pkptr+1;
  2607.       i = i + 1;
  2608.     end;
  2609.     pk = null;        /* terminate with null for printing */
  2610.     pkptr = packet;
  2611.  
  2612.     chksum = (chksum + ((chksum and 192) / 64)) and 63;
  2613.  
  2614.     if debug then do;
  2615.     call print(@('His checksum: ',null));
  2616.     call nout(buffer(msglen));
  2617.     call co('_');
  2618.     end; /* debug */
  2619.     hischksum = unchar(buffer(msglen));
  2620.     if debug then do;
  2621.     call nout(hischksum);
  2622.     call print(@(cr,lf,'Our checksum: ',null));
  2623.     call nout(chksum);
  2624.     call newline;
  2625.     end; /* debug */
  2626.     if chksum = hischksum then do;
  2627.       if debug then call co('.');
  2628.       if type='E' then do;
  2629.         if len>0 then call print(@pk);
  2630.       end;
  2631.       return type;
  2632.     end;
  2633.     call print(@('Bad checksum received', crlf));
  2634.     len=0;
  2635.     return 'E';
  2636. end rpack;
  2637.  
  2638.  
  2639.  
  2640.  
  2641. /* SDATA: this routine sends the data from the buffer area to the host.    */
  2642. /* It takes no parameters but returns the next state depending on the    */
  2643. /* type of acknowledgement.                        */
  2644.  
  2645. sdata:     procedure byte;
  2646.     declare (num, length, retc) byte;
  2647.  
  2648.     if debug then call print(@('sdata...',crlf));
  2649.  
  2650.     if tries > maxtry then return 'A';
  2651.       else tries = tries + 1;
  2652.  
  2653.     call spack('D', msgnum, pklen, .send$packet);
  2654.     retc = rpack(.length, .num, .recv$packet);
  2655.     if (retc = 'N') then return state;
  2656.     if (retc <> 'Y') then return 'A';
  2657.     /* here when good acknowledgement */
  2658.     tries = 0;
  2659.     msgnum = (msgnum + 1) mod 64;
  2660.     pklen = bufill(.send$packet);
  2661.     frac$tot=(byte$out*100)/byte$tot;
  2662.     call print(@('output ',null));
  2663.     call noutd(byte$out);
  2664.     call print(@(' bytes = ',null));
  2665.     call nout(frac$tot);
  2666.     call print(@('%',cr,null));
  2667.     if pklen > 0 then return 'D';
  2668.       else return 'Z';
  2669. end sdata;
  2670.  
  2671.  
  2672. /* SFILE: this routine sends a packet to the host which contains the     */
  2673. /* filename of the file being sent so that the file can be created at    */
  2674. /* the host end. It returns a new state depending on the nature of the    */
  2675. /* the hosts acknowledgement.                        */
  2676.  
  2677. sfile:     procedure byte;
  2678.     declare (num, length, retc) byte;
  2679.     declare fnptr address;
  2680.     declare fnindex based fnptr byte;
  2681.  
  2682.     if debug then call print(@('sfile...',crlf));
  2683.  
  2684.     if tries > maxtry then return 'A';
  2685.       else tries = tries + 1;
  2686.  
  2687.     if debug then call print(@(cr,lf,'Filename is: ',null));
  2688.     call prints(@filename);
  2689.     call newline;
  2690.     if debug then do;
  2691.     call print(@(cr,lf,'length is: ',null));
  2692.     call nout(length);
  2693.     call newline;
  2694.     end; /* debug */
  2695.     call spack('F', msgnum, filename.len,.filename.name);
  2696.     retc = rpack(.length, .num, .recv$packet);
  2697.  
  2698.     if (retc = 'N') then return state;
  2699.     if (retc <> 'Y') then return 'A';
  2700.     /* here on valid acknowledgement */
  2701.     tries = 0;
  2702.     msgnum = (msgnum + 1) mod 64;
  2703.     pklen = bufill(.send$packet);
  2704.     if debug then call nout(pklen);
  2705.     if debug then call newline;
  2706.     if pklen > 0 then return 'D';
  2707.       else return 'Z';
  2708. end sfile;
  2709.  
  2710.  
  2711. /* SEOF: this routine is used when eof is detected, it closes up and    */
  2712. /* returns the new state as usual.                    */
  2713.  
  2714. seof:    procedure byte;
  2715.     declare (num, length, retc) byte;
  2716.  
  2717.     if debug then call print(@('seof...',crlf));
  2718.  
  2719.     if tries > maxtry then return 'A';
  2720.       else tries = tries + 1;
  2721.  
  2722.     call spack('Z', msgnum, 0, .send$packet);
  2723.     retc = rpack(.length, .num, .recv$packet);
  2724.     if (retc = 'N') then return state;
  2725.     if (retc <> 'Y') then return 'A';
  2726.     /* here on valid acknowledgement */
  2727.     byte$out=0;
  2728.     tries = 0;
  2729. /* here is where you open next file if wildcard spec. */
  2730.     filename.len=0;
  2731.     msgnum = (msgnum + 1) mod 64;
  2732.     if filename.len=0 then
  2733.         return 'B';
  2734.     else do;
  2735.         call file$open(1);
  2736.         return 'S';
  2737.     end;
  2738. end seof;
  2739.  
  2740.  
  2741. /* SINIT: this routine does initialisations and opens the file to be    */
  2742. /* send, it returns a new state depending on the outcome of trying to    */
  2743. /* open the file.                            */
  2744.  
  2745. sinit:    procedure byte;
  2746.     declare (len, num, retc) byte;
  2747.  
  2748.     call print(@(cr,lf,'Sending ',null));
  2749.  
  2750.     if tries  > maxtry then return 'A';
  2751.       else tries = tries + 1;
  2752.  
  2753.     call spar(.send$packet);
  2754.     call spack('S', msgnum, 6, .send$packet);    /* send start packet */
  2755.  
  2756.     retc = rpack(.len, .num, .recv$packet);
  2757.     if (retc = 'N') then return state;
  2758.     if (retc <> 'Y') then return 'A';
  2759.     /* here on valid acknowledgement */
  2760.     call rpar(.recv$packet);
  2761.     if eol = 0 then eol = send$eol;
  2762.     if quote = 0 then quote = send$quote;
  2763.     byte$out=0;
  2764.     tries = 0;
  2765.     msgnum = (msgnum + 1) mod 64;
  2766.     return 'F';
  2767. end sinit;
  2768.  
  2769.  
  2770. /* SBREAK: this module breaks the flow of control at the end of a     */
  2771. /* transmission and allows the send routine to terminate by returning    */
  2772. /* either a successful or failure condition to the main kermit routine. */
  2773.  
  2774. sbreak:    procedure byte public;
  2775.     declare (num, length, retc) byte;
  2776.  
  2777.     if debug then call print(@('sbreak...',crlf));
  2778.  
  2779.     if tries > maxtry then return 'A';
  2780.       else tries = tries + 1;
  2781.  
  2782.     call spack('B', msgnum, 0, .send$packet);
  2783.     retc = rpack(.length, .num, .recv$packet);
  2784.  
  2785.     if (retc = 'N') then return state;
  2786.     if (retc <> 'Y') then return 'A';
  2787.     /* we only get here if we received a valid acknowledgement */
  2788.     tries = 0;
  2789.     msgnum = (msgnum + 1) mod 64;
  2790.     return 'C';
  2791. end sbreak;
  2792.  
  2793. /* serror: this module sends an error packet to abort the transmittion */
  2794.  
  2795. serror:    procedure byte;
  2796.     declare (num, length, retc) byte;
  2797.  
  2798.     if debug then call print(@('serror...',crlf));
  2799.  
  2800.     if tries > maxtry then return 'A';
  2801.       else tries = tries + 1;
  2802.  
  2803.     call spack('B', msgnum, 0, .send$packet);
  2804.     retc = rpack(.length, .num, .recv$packet);
  2805.  
  2806.     if (retc = 'N') then return state;
  2807.     if (retc <> 'Y') then return 'A';
  2808.     /* we only get here if we received a valid acknowledgement */
  2809.     tries = 0;
  2810.     msgnum = (msgnum + 1) mod 64;
  2811.     return 'A';
  2812. end serror;
  2813.  
  2814. send$setup: procedure public;
  2815.     msgnum = 0;
  2816.     tries = 0;
  2817.  
  2818.     spsize = send$paclen;
  2819.     timeint = send$time;
  2820.     numpads = send$padding;
  2821.     padchar = send$padchar;
  2822.     eol = send$eol;
  2823.     quote = send$quote;
  2824. end send$setup;
  2825.  
  2826.  
  2827. /* SEND: here's the main code for the send command, it's a FSM for    */
  2828. /* sending files. The main loop calles various routines until it     */
  2829. /* finishes or an error occurs; this is signified by a true or false     */
  2830. /* result being returned to the main 'kermit' routine.            */
  2831.  
  2832. send:    procedure byte public;
  2833.  
  2834.     state = 'S';                /* start in Send-Init state */
  2835.     call send$setup;
  2836.  
  2837.     send_delay=double(send$delay)*100;
  2838.     if co$conn=out$conn then call RQ$SLEEP(send_delay,@status);
  2839.  
  2840.     do while true;
  2841.       if debug then
  2842.         do;
  2843.           call print(@('state : ',null));
  2844.           call co(state);
  2845.           call newline;
  2846.         end;
  2847.       if state = 'D' then state = sdata;
  2848.       else
  2849.         if state = 'F' then state = sfile;
  2850.         else
  2851.           if state = 'Z' then state = seof;
  2852.           else
  2853.             if state = 'S' then state = sinit;
  2854.         else
  2855.           if state = 'B' then state = sbreak;
  2856.               else
  2857.                 if state = 'C' then return true;
  2858.             else
  2859.               if state = 'A' then return false;
  2860.             else
  2861.               if state = 'E' then return false;
  2862.           else return false;
  2863.     end;
  2864. end send;
  2865.  
  2866. end send$module;
  2867. /*---TRANS.P86---*/
  2868. /*  Transmit routine */
  2869. $compact
  2870. $optimize(3)
  2871.  
  2872. trans$module: do;
  2873.  
  2874. $INCLUDE(:INC:LTKSEL.LIT)
  2875.  
  2876. declare true  literally '0FFH';
  2877. declare false literally '0';
  2878. declare cr    literally '0DH';
  2879. declare lf    literally '0AH';
  2880. declare null  literally '0';
  2881.  
  2882. $INCLUDE(:INC:NSLEEP.EXT)
  2883. $INCLUDE(:INC:UREAD.EXT)
  2884. $INCLUDE(:INC:UWRITE.EXT)
  2885.  
  2886. declare status word external;
  2887. declare trans_wait word external;
  2888. declare in$conn token external;
  2889. declare out$conn token external;
  2890. declare file$conn token external;
  2891. declare iobuff(1024) byte external;
  2892.  
  2893. check$error: procedure (fatal) byte external;
  2894.     declare fatal byte;
  2895. end check$error;
  2896.  
  2897. nout: procedure(n) external;
  2898.     declare n word;
  2899. end nout;
  2900.  
  2901. do$co: procedure external;
  2902. end do$co;
  2903.  
  2904. print: procedure(string) external;
  2905.     declare string pointer;
  2906. end print;
  2907.  
  2908. trans: procedure byte public;
  2909.     declare (i,qcr) byte;
  2910.     declare len byte;
  2911.     declare (rec$num,len1) word;
  2912.     rec$num=0;
  2913.     qcr=true;
  2914.     do while true;
  2915.       len=DQ$READ(file$conn,@iobuff,64,@status);
  2916.       if check$error(0) then return false;
  2917.       if len=0 then goto clean$up;
  2918.       len1=256;
  2919.       do i=0 to len-1;
  2920.         iobuff(len1)=iobuff(i);
  2921.         if qcr then do;
  2922.           qcr=false;
  2923.           if iobuff(len1)=lf then len1=len1-1;
  2924.         end;
  2925.         else if iobuff(len1)=cr then qcr=true;
  2926.         len1=len1+1;
  2927.       end;
  2928.     CALL NOUT(LEN1);
  2929.       if len1>256 then
  2930.         call DQ$WRITE(out$conn,@iobuff(256),len1-256,@status);
  2931.       if check$error(0) then return false;
  2932.       rec$num=rec$num+1;
  2933.       call nout(rec$num);
  2934.       call print(@(cr,null));
  2935.       call RQ$SLEEP(trans_wait,@status);
  2936.       if check$error(0) then return false;
  2937.       len=DQ$READ(in$conn,@iobuff,250,@status);
  2938.       if check$error(0) then return false;
  2939.     end;
  2940. clean$up:
  2941.     call RQ$SLEEP(trans_wait,@status);
  2942.     if check$error(0) then return false;
  2943.     len=DQ$READ(in$conn,@iobuff,250,@status);
  2944.     if check$error(0) then return false;
  2945.     return true;
  2946. end trans;
  2947.  
  2948. end trans$module;
  2949.